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1.0 INTRODUCTION 

Most subroutines in the 1130 Statistical System are documented by- 
means of a flowchart. The exceptions are those very short routines, 
FORTRAN-coded, which can be easily understood from the listings, 
and the Assembly Language subroutines as noted in the index on the 
next page. The comments and flowcharts associated "with the Assembly 
Language subroutines will be supplied upon request. 

Figure 1 illustrates the various blocks used in the flowcharts and 
their particular meaning. Lines connecting these blocks are made 
up of periods. Arrows showing the direction of flow are represented 
by an X. 

Connector symbols use the following conventions: four -digit symbols 
refer to chart symbol (two digits) and block (two digits). For 
example, ABH1 refers to block HI on Chart AB. Two-digit symbols 
refer to a block on the chart where the reference appears. For 
example, Hi appearing on Chart AB refers to block HI on the chart. 



Index of Subroutines 



NAME 


LABEL 


FLOW CHARTS 


NARRATIVES 


LISTINGS 




cc. 73-76 


Chart Symbol 


Page 


5 


Page 


AN0V2 


NOV2 


EA 




6, 


30 


68 


ANOVA 


NOVA 


DW 




5, 


29 


66 


COREL 


CORL 


DB 




4, 


24 


55 


COVEC 


CVEC 


EN 






17 


87 


DATR.D 


DTRD 


** 






41 


49 


FCTR 


FCTR 


DM, 


DN 


5, 


12 


71 


FCTR1 


FCT1 


EG 




5, 


13 


73 


FCTR2 


FCT2 


EL, 


EM 


5, 


15 


76 


FCTR3 


FCT3 


EP 




5, 


18 


82 


FMAT 


FMAT 


HH 






42 


85 


FMTRD 


FMRD 


** 






40 


47 


GDIV 


GDIV 


* 






42 


53 


GET 


GETO 


DY 






29 


68 


GMPY 


GMPY 


* 






42 


52 


INVRS 


INVS 


EH 






13 


73 


MATIN 


MATN 


EZ, 


FA 




22 


83 


MNSQ 


MNSQ 


EC, 


ED, EE 




31 


69 


MXRAD 


MXRD 


DA 






26 


54 


PCOEF 


PC OF 


DJ 






37 


57 


PDER 


PDER 


DL 






38 


61 


PFi'l' 


PFIT; 


DK 






39 


60 


POL2 


POL2 : 


DF 




6, 


36 


58 


POLSQ 


PLSQ 


DH 






36 


59 


POLY 


POLY 


DD 




6, 


35 


57 


PROMX 


PRMX 


ES 






19 


78 


PRNT 


PRNT 


DC 






25 


56 


PRNTB 


PRNB 


#* 






41 


49 


QR 


QROO 


EJ 






15 


75 


VARMX 


VRMX 


ET, 


EW, EX 




18 


79 


VECTR 


VCTR 


EN 






16 


80 


REGR 


REGR 


DM, 


DN 


4, 


8 


62 


REGR2 


RGR2 


DP 




4, 


9 


63 


REGRE 


RGRE 


DR, 


DS, DT 




10 


64 


REPRT 


RPRT 


EF 






32 


70 


RFOUT 


ROUT 


ER 






20 


77 


RPRNT 


RPNT 


EY 






21 


82 


SCORE 


SCOR 


FB 






22 


84 


SDOP 


SDOP 


EB 






30 


69 


STORE 


STOR 


DY 






29 


67 


TRAN 


TRAN 


* 






43 


54 


TRIDI 


TRID 


EJ 






14 


74 


XMAX 


XMAX 


* 






23 


74 



* Item is not included; listing is considered to be of sufficient aid. 
**Item is not included; also, listings are not commented. 
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Enter or exit block 




Processor block 



Modification block 




Decision block 




Call to subroutine block 



Connector to block within page 



Connector to block on another page 



Figure 1. Flowchart blocks 



2.0 GENERAL SYSTEM FLOWCHART NARRATIVES 
A. Regression and Factor Analysis 

(1) Regression 

This program uses three main linkage routines, REGR, COREL, 
and REGR2. These routines perform functions as follows. 

(a) REGR: This routine reads standard program control cards, 
and either calls the matrix read subroutine, MXRAD, or 
reads the data format cards, with FMTRD, and the data 
cards, with DATRD. In either case, initialization is 
performed, and if matrix input is called for, and the matrix 
is a correlation matrix, the link REGR2 is called. If the 
matrix is the raw sum of squares matrix, the link COREL 
is called. If card input is the type called for, the raw sum 
of squares matrix is computed, sequence checks are made 
on option, the transformation routine TRAN is called on 
option, sums of observations on variables are computed 
and the observations as transformed are placed on the disk. 

If disk input is desired, the data format cards are not read, 
sequence check is ignored, but TRAN is called on option. 
Thus observations previously transformed will be again 
transformed if the option is taken. 

Finally, for card or disk input, the link COREL is called. 

(b) COREL: This routine computes the residual cross products 
matrix, mean, standard deviations, and correlation matrices. 
Each of the matrices is printed and/or punched on option 

by calling the subroutine PRNT. If the raw sums of squares 
matrix or correlation matrix has been punched, COREL then 
punches raw sums and sums of squares, or means and 
standard deviations. 

Finally, depending on a switch set in REGR or FCTR, COREL 
calls the link REGR2 or FCTR1. 

(c) REGR2: REGR2 exits to the monitor if no regression is 
called for. Otherwise the subroutine REGRE is called, after 
which an exit is made . 

(2) Factor Analysis: 

This program uses five main linkage routines, FCTR, COREL, 
FCTR1, FCTR2, and FCTR3, as follows. 



(a) FCTR: Input logic in FCTR is identical with that described 
under REG.R above. On exit, FCTR calls the links COREL 
or FCTR1, depending on the need for a correlation matrix. 

(b) COREL: Described above under Regression. 

(c) FCTR1: This routine chooses and calculates the communalities, 
if necessary. Then the subroutines TRIDI and OJR are called for 
eigenvalue computation, after which the link FCTR2 is called. 

(d) FCTR2: After determining the number of factors to be 
rotated, FCTR2 calls VECTR to compute the eigenvectors. 
It is at this point that, for the minimization of the number 
of links required, certain arrays are given a maximum 
length of ten. The number of eigenvectors computed and 
the number of factors rotated could exceed ten but for this 
limitation, which could be eliminated* Eigenvectors are then 
printed on option, then standardized so that the unrotated 
factor loadings can be printed, and then communalities are 
computed and printed. 

Finally, if a rotation is called for, link FOTR3 is called; if not, 
FCTR2 exits to the monitor. 

(e) FCTR3: FCTR3 either calls VARMX for a varimax rotation 
or exits to the monitor. If VARMX is called, then an oblique 
rotation is performed by calling PROMX or an exit is performed. 
VARMX and PROMX use RFOUT for output. Factor scores 

and regression coefficients are computed on option by call- 
ing SCORE. Finally, FCTR3 exits to the monitor. 

B. Analysis of Variance: 

This program uses two main linkage routines, ANOVA and 
ANOV2, which function as follows. 

(1) ANOVA: Standard program control cards are read, followed 
by the option card. After initialization is performed, card or 
disk input is chosen. If the data is on cards, FMTRD is used 
to specify data format, and DATRD to read according to that 
format. After each card, the data is written on the disk. After 
transforming (TRAN) on option, the program uses STORE if 
disk storage is required for the design being analyzed. Finally, 
link ANOV2 is called. 

If the data is to be read from disk, format read is ignored, and 
the program reads from disk, and calls TRAN and STORE if 
necessary, before calling link ANOV2. 



(2) AN0V2: This routine calls SDOP, which generates sums 
and deviates for each factor, MNSQ, which computes com- 
ponent and interaction sums of squares, and REPRT, which 
arranges the analysis of variance table according to the user 
specified table generation cards. Then the program exits 
to the monitor. 

C. Orthogonal Polynomials: The main linkages for this program 
are POLY and POL2. 

(1) POLY: After reading all program control cards, POLY 
chooses disk, cards, or solution vector input. In the case 
of cards or solution vectors, format read (FMTRD) is 
called to set up data card format. If input is from cards, 
data is read by DATRD, and written on the disk. Disk input 
or card input then is transformed on option, initialization 

is performed, and if scaling is to be performed, the scaling 
equation is calculated. Then link POL2 is called. 

If solution vectors are to be read, scaling constants and 
solution vectors are accepted, secondary input (points for 
polynomial evaluation) is read with DATRD, and link APOL2 
is called. 

(2) POL2: This link calls POLSQ unless solution vectors 
were the input data. POLSQ calculates the orthogonal 
polynomials and prints them, as well as the solution vectors. 
If solution vector output is called for, those and the scaling 
constants are punched by POLSQ. 

If the polynomial coefficients are requested, PCOEF is 
called. If derivatives are required, PDER is called. Finally, 
PFIT is called if predicted values are desired, after which 
APOL2 exits to the monitor. 



3.0 DETAILED FLOWCHART NARRATIVES S 

A. Regression Analysis: This program contains three links. 
LINK SUBROUTINES USE 



REGR 


Main Program 


Inputs parameter cards 
and source data 


COREL 


Main Program 


Computes correlation 

matrix 


REGR2 


REGRE 


Computes regression 



equations 

The links communicate with their successors by storing results 
in common storage. 



COMMON DATA STORAGE MAP - Regression Analysis 





Common 






Name 


Dimension* 


Type 


Meaning 


ICR 


1 


I 


Card read symbolic unit 


ICP 


1 


I 


Card punch symbolic unit 


IPR 


1 


I 


PRINT- TYPE Switch 


ITW 


1 


I 


Output unit numbers 


IT1 


1 


I 


Not used 


IT2 


1 


I 


Not used 


IPROB 


1 


I 


Problem number 


N 


1 


I 


Number of variables 


NF 


1 


I 


Not used 


CASES 


1 


F 


Sum of weights 


NPAGE 


1 


I 


Page number 


INMD 


1 


I 


Input mode switch 


IPRED 


1 


I 


Predicted score switch 


ISTEP 


1 


I 


Print steps switch 


ICNST 


1 


I 


Pooling switch 


IREAR 


1 


I 


Dependent variable 


KX 


1 


I 


Not used 


MX 


20 


I 


Matrix output options 


NCD 


3 


I 


Number of variables on Cards 
1, 2, and 3 


ISEQ 


1 


I 


Sequence check switch 


NCASE 


1 


I 


Number of data cases 



NX 


10 


EFOUT 


1 


EFIN 


1 


TOL 


1 


FLVB 


2 


KNN 


1 


TITLE 


18 


VNAME 


30 


SUMY 


30 


SD 


30 


X 


30 


R 


(30, 30) 


HIGH 


30 


HLOW 


30 


MF 


(50, 3) 



I Not used 

F Criterion for removing vari- 

ables in REGRE 
F Criterion for entering vari- 

ables in REGRE 
F Tolerance for inverse 

F Not used 

I REGR or FCTR switch 

F Page title 

F Variable names 

F Summary vector - (Means) 

F Summary vector - (standard 

deviations) 
F Temporary data vector storage 

F Storage matrix (Correlation) 

F High value of each variable 

F Low value of each variable 

I Variable format storage 

The actual number of storage locations occupied by the common 
variables depends on the variable type. An I, or integer variable, 
occupies 1 location for each dimension, whereas an F, or Float- 
ing Point variable, occupies 2 storage locations. 



LINK NAME: REGR 
CALLED BY: // XEQ, 

This link is used to set common storage with all necessary parameters 
and data for a multiple regression (REGR). The program begins by 
reading an input/output units designation card from the card reader. 
This will store the symbolic units ICR, ICP, IPR, ITW, ITl, IT2. The 
job-title card, regression card and variable names cards are then read 
from the symbolic unit ICR and job- title and option cards are printed 
with verbal designation of their meaning on symbolic unit ITW. If 
INMD = 1 a variable format card will be read and printed. If NCD2 =f= 
a second variable format card will be read and printed and if NCD3 =j= 
a third format card will be read and printed. Storage and accumulation 
arrays are initialized and a branch is taken to the appropriate input 
section determined by the parameter INMD. 

If INMD =la data vector containing case identification; card number, 
weight, field and data elements X (I), 1 = 1, N where N is the number 
of variables set by the user, will be read from the card reader and 



8 



stored on the disk. If the parameter ISEQ =£ and the NCD(I) are set 
to the proper values the input cards will sequence check within case 
before the elements X (I) from the card are stored. If INMD=2 the 
data vector will be transferred from the disk to the core vector X 
When INMD=3 the source data is a matrix and will be read from the 
card reader, by the subroutine MXRAD. 

Once the data vector has been transferred from the input device to 
the core vector X a test is made to see if the case identification field 
ID1 is negative or zero. If it is non-positive, the next link (REGR2 or 
COREL) is read into core storage and executed. 

If INMD =f= 3, the program accumulates the sums vector and sums of 
squares and cross products matrix from the data vector X. In addition, 
the high and low value of each element in X is also determined. When 
this information is completed the program branches back to read an- 
other data vector. 

On exit, all options, heading information, and I/O unit designations are 
stored in common, along with the summary statistics and cross- 
product matrix of the input matrix (if the input matrix was a data matrix) 
or the input matrix itself (if it was a correlation or cross-product 
matrix) . The common variable NCASE indicates which type of input 
was accepted. 



LINK NAME: COREL 
CALLED BY: REGR or FCTR 
For a description of COREL, see Section 3C. 



LINK NAME: REGR 2 



CALLED BY: COREL or REGR 



The first thing that the link REGR2 does is test the parameter IREAR, 
which normally contains the column number of the dependent variable, 
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to determine whether a regression analysis should take place . If 
IREAR = 0, subroutine REGRE will not be called and the program 
will finish with a call exit statement. If IREAR is greater than zero 
the subroutine REGRE will be called and the regression equations com- 
puted from the correlation matrix, means and standard deviations 
located in common storage. 



SUBROUTINE REGRE 
CALLED BY: REGR2 
REGRE performs the following functions: 

1 . The dependent variable is placed in the last row and column of 

the correlation matrix R. That is, r.. is moved to the last row and 

ii 
column of R . J 

Other pertinent vectors are similarly changed. 

2 

2. r. /r. , is checked to determine entry variables. If none is 

i> y !> i 

entered, REGRE returns to REGR2. Otherwise, requested output is 
prepared and printed. 

3. Entry and exit significance levels are checked, variables for 
entry or exit are chosen, and output is presented until either degrees 
of freedom are zero, no more variables are to be entered or removed, 
or the residual mean square is negative . 
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B. Factor Analysis: This program will perform a complete factor 

analysis from either the raw data or a pre-computed correl- 
ation matrix. 

The factor analysis program contains five links: 

LINK SUBROUTINE USE 



FCTR 

COREL 
FCTR1 

FCTR. 2 

FCTR3 



Main program 

Main program 
TRIDI 

OR 

VECTR 

COVEC 

VARMX 

PROMX 

SCORE 



Inputs parameter cards and 
source data 

Computes correlation matrix 
Tridiagonalizes matrix 
Computes eigenvalues 
Computes eigenvectors 
Solves tridiagonal equations 
Orthogonal factor rotation 
Oblique factor rotation 
Computes and outputs factor 
scores 



Each of these links communicates with its successor by storing its 
results in common storage . 

COMMON DATA STORAGE MAP - Factor Analysis 





Common 






Name 


Dimension* 


Type 


Meaning 


ICR 


1 


I 


Card reader symbolic unit 


ICP 


1 


I 


Card punch symbolic unit 


IPR 


1 


I 


Print-type switch 


ITW 


1 


I 


Printer -typewriter unit 


IT1 


1 


I 


Not used 


IT2 


1 


I 


Not used 


IPROB 


1 


I 


Problem number 


N 


1 


I 


Number of variables 


NF 


1 


I 


Number of factors 


CASES 


1 


F 


Sum of weights 


NPAGE 


1 


I 


Page number 


INMD 


1 


I 


Input mode switch 


IPRED 


1 


I 


Factor score switch 



* The actual number of storage locations occupied by the common vari- 
ables depends on the variable type. An: I, or integer variable, occupies 
1 location for each dimension, whereas an F, or floating point variable, 
occupies 2 storage locations. 
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ICOM 


1 


I 


EOT 


1 
1 


I 


NFKT 


I 


KX 


1 


I 


MX 


20 


I 


NCD 


3 


I 


ISEQ 


1 


I 


NCASE 


1 


I 


KCNT 


1 


I 


KNN 


1 


I 


NX 


9 


I 


TRC 


1 


F 


FLVB 


4 


F 


TITLE 


18 


F 


VNAME 


30 


F 


SUMY 


30 


F 


SD 


30 


F 


X 


30 


F 


R 


(30,30) 


F 


HIGH 


30 


F 


HLOW 


30 


F 


MF 


(50, 3) 


I 


ALPHA 


30 


F 


BETA 


30 


F 



Communality option 

Rotation switch 

Number of factors to rotate 

VARMX/PROMX switch 

Matrix output options 

Number of variables on Cards 

1, 2, and 3 

Sequence check switch 

Number of data cases 

Parameter for factor count 

REGR or FCTR Switch 

NX(1) is a pooling switch 

Trace 

Not used 

Page title 

Variable names 

Summary vector (Means) 

Summary vector (Standard 

deviations) 
Temporary data vector storage 
Storage matrix(Correlation) 
High value of each variable 
Low value of each variable 
Format storage 

(Contain elements 
of tridiagonal matrix 



LINK NAME : FCTR 

CALLED BY: //XEQ 

The first link loaded is FCTR which reads all parameter cards and 
stores the analysis options and parameters in common storage. Then 
either a pre-computed matrix is read or a raw cross product matrix 
is formed from the raw data matrix. The common variable NCASE is 
set to either a negative or positive value depending on whether a corre- 
lation matrix or input data was read. Link FCTR1 is then loaded 
into core if NCASE is less than zero; otherwise link COREL is loaded. 
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LINK NAME: FCTR1 

CALLED BY: LINK FCTR 

This link is used as a factor analysis setup program. From the 
parameter ICOM, which has been determined by the user, the diagonal 
elements of the correlation matrix are replaced by estimates of the 
communalities . There are three possible values of ICOM and these 
correspond to the three primary branches in the program. 

If ICOM = 0, the diagonal elements of the correlation matrix are un- 
changed. In effect, this corresponds to a principal components analysis 
where the communality estimate is equal to 1. 

If ICOM = 1, each element on the diagonal will be replaced by the 
absolute value of the largest off -diagonal element in a row. 

If ICOM = 2, each diagonal element will be replaced by the square of 
the multiple correlation coefficient (i.e. , if i represents the ith diagonal 
element, then R . will be the multiple correlation between the ith vari- 
able and all other variables in the matrix) . 

After the communality estimates have been determined, the program 
computes the trace of the matrix by summing the diagonal elements and 
storing the result at the symbolic location TRC. The subroutines TRIDI 
and QR are then called to compute the eigenvalues of the new matrix. 

Upon entry to the program, the correlation matrix, or matrix to be 
factored, is assumed to be located in the matrix R . The parameters N 
and ICOM have been read into common storage by link FCTR. 

When link FCTR2 is called the trace of the correlation matrix is in 
location TRC, the diagonal elements of the tridiagonalized correlation 
matrix are in array ALPHA, the off-diagonal elements are in array 
BETA and the eigenvalues are in array X. 



SUBROUTINE NAME: INVRS 
CALLED BY: FCTR1 
Description: INVRS inverts a symmetric matrix with unit diagonal 
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elements. On entry, the matrix is in array R. The upper triangular 
part of the matrix is replaced by the elements of the inverse . The 
part below the diagonal is not modified . 



SUBROUTINE: TR3DI 

CALLED BY: FCTRl 

This subroutine converts a symmetric matrix to tridiagonal form. 

The method employed is Householder's method. In this method, N-2 
elementary orthogonal transformations are chosen in such a way that 
the transformation will leave only the first subdiagonal element in the 
rth column nonzero. The final matrix 

A' =P P q...P P 1 AP 1 P ...P oP 9 
n-2 n-3 2 1 12 n-o n-2 

can be stored in two arrays, the first (ALPHA) containing the elements 
of the main diagonal and the second (BETA) containing the first sub- 
diagonal element in each column (except the last) . 

Along with the transformed matrix a transformation matrix is formed 
and stored over the original matrix., This matrix is computed as 

T = P 1 P 2 P 3 ,,-P n-2 

and has the property that an eigenvector of the tridiagonal matrix, when 
premultiplied by T, becomes an eigenvector of the original input matrix. 

On entry, the correlation matrix is in array R. 

On exit, the transformed matrix is in common arrays ALPHA and 
BETA. The transformation matrix is in R. The infinity norm of the 
transformed matrix is in the common cell ANORM. 
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SUBROUTINE QR 
CALLED BY: FCTRl 

' 'I'""-" ■ l—HMWKi I ■ i. iiiiaii-in|i 

QR finds up to thirty eigenvalues of the tridiagonal matrix previously- 
prepared by the routine TRIDI. The QR method is used. 

On exit, the eigenvalues are in descending order in the vector X. 



LINK NAME: FCTR2 

CALLED BY: LINK FCTRl 

This subroutine is used to compute and output the factor matrix. First 
it determines the number of factors to compute from the parameters 
NF and KCNT. If NF = then the factors computed will be those which 
have characteristic values greater than or equal to 1 . If NF = 2 then 
the number of factors computed will be the number which is in KCNT. 
If NF = 3 the number of factors computed will be only those factors 
which account for KCNT percentage of the trace. 

As each characteristic value is examined a cumulative sum is computed 
and the cumulative percentage of trace is computed. 

The routine VECTR is called to compute the required number of eigen- 
vectors, and the factor matrix is computed by the expressions: 

R(I, J) = R(I, J) * SQRT(XtJ3) 

where R(I, J) on the right side of the equal sign contains the character- 
istic vector and X(J) is the Jth characteristic value. 

Once the factor computation has been completed the characteristic 
values and cumulative percent of trace are printed along with the title, 
page number, trace, sum of the characteristic values, and the differ- 
ence between the trace and sum. Subroutine PRNT is then called to 
output the factor matrix. Communalities are calculated from the sums 
of. squares of the row elements of the factor matrix, and printed. 

When the link is called the elements of the tridiagonal matrix are in 
arrays ALPHA and BETA, and the characteristic values are in array 
X. The parameters NF and KCNT are at values assigned by the user. 
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Upon exit from the link R contains the principal axis factor matrix. 

The parameters NF and KCNT have been changed to the following values: 

Entry ; Exit 

NF NF KCNT 



1 

2 KCNT 

3 KCNT 



SUBROUTINE NAME: VECTR 



CALLED BY: FCTR2 



VECTR is a subroutine that computes NF eigenvalues of an N x N 
matrix by computing the eigenvalues of the tridiagonalized matrix 
obtained by subroutine TRIDI and transforming them to the charact- 
eristic vectors of the original matrix via a transformation matrix. 
(See TRIDI narrative. ) 

th 
The method by which the K eigenvector is found is as follows: 

The eigenvector array (V) is initialized to ones as a first approximation. 
Subroutine COVEC is called to compute 

Q= (A-X k I)~ 1 V 

where A is the tridiagonalized matrix and Xk is the kth eigenvalue. If 
V and Q., when normalized, do not agree (element for element) within 
. 05, V is set equal to Q. and the routine reiterates. If V and Q agree, 
the vector 

R = V - (A-X k I) Q 

is formed and COVEC is called to compute 

Y = (A-X k D _1 R. 

Z = V + Y is then the eigenvector of the tridiagonal matrix. Z is then 
normalized and premultiplied by the transformation matrix and written 
onto the disk. 

When all NF eigenvectors have been found and written on the disk, they 
are read back in over the transformation matrix. 
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The tridiagonalized matrix must be in arrays ALPHA and BETA, its 
eigenvalues must be in array X, and the transformation matrix must 
be in the Matrix R, on entry. 

On exit, the eigenvectors are in R and the transformation matrix is 
destroyed. If a rotation is required, FCTR3 is called. 



SUBROUTINE NAME: COVEC 
CALLED BY: VECTR 

COVEC solves the system of tridiagonal equations 

(A - Xl) * V=C 

for V, where A is a tridiagonal matrix of the form 



a.b 


. . 


b 2 a 2 b 3° ° 


. . 


bgaJD, 




b 4 a 4 




. 




. 


. 


• • • 


. b 
n 


0.. 


0b a 
n n 



which was stored in the arrays ALPHA and BETA. X is an approxi- 
mate eigenvalue of A, and C is a column vector. An eliminative scheme 
is used which uses the largest element in each column as its pivot 
element. 

The arguments used when calling this routine have the following 
meaning: 

CONS = Vector or right side of equation 

VECT = Vector to be solved for 
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In addition, the program requires the arrays ALPHA and BETA, 
The solution vector is in the argument VECT, on exit. 



SUBROUTINE NAME: PR NT 
CALLED BY: FCTR2 
This subroutine is described in Section 3C. 



LINK N AME: FCTR.3 

■■ ■ i ■"■■■ ■' '-■— — ^— 

CALLED BY: FCTR2 

This link calls VARMX if an orthogonal rotation is required, PROMX 
if an oblique rotation is required, and SCORE for factor score calcu- 
lations. RFOUT is used for output, and MATIN for matrix inversion. 
FCTR3 then exits to the monitor. 



SUBROUTINE NAME: VARMX 

CALLING PROGRAM : FCTR3 

After initializing NFRT, the number of factors to be rotated, and 
setting the tolerance EPS, the program sets the B matrix to an identity 
matrix. The A matrix, which contains the factors to be rotated, 
is then row normalized by dividing each row element by the communality 
for that row. 

The main iteration cycle is then initiated by computing a convergence 
criterion and comparing it to the criterion on the previous cycle. If it 
is approximately zero, control will be returned to calling program. If 
greater than zero it initiates a new cycle. A cycle consists of a pairwise 
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rotation of the factor matrix. The program determines the sine and 
cosine of the angle of rotation and proceeds to apply this angle to the 
matrix. However, if this angle is less than 1 minute of 1 degree (EPS) 
then a rotation will not be effected. 

After the factor matrix has been rotated by the sine and cosine of the 
rotating angle, the B matrix,which initially contains the identity matrix, 
is also rotated by this angle. The program then begins another iter- 
ation cycle. At the beginning of each iteration the cycle count and con- 
vergence criterion are printed. A test is made to determine if more 
than 50 cycles have taken place . If so the program will terminate . 

Upon entry to the program tne factor matrix is located at A, the 
number of factors to be rotated is contained in NFRT. If this field 
is zero, the program will set it equal to the number of factors as 
determined by the program FCTR2. 

Upon exit from the program the array A contains the orthogonally 
rotated matrix and B contains the transformation matrix. 



SUBROUTINE NAME: PROM X 

CALLING PROGRAM: FCTR3 

This subroutine, in conjunction with RFOUT, is used to perform an 
oblique rotation of a factor matrix. 

After setting IAL to four, the program computes the inverse of A T - A = B 
where A is the orthogonal factor matrix and A T its transpose. 

Row- and column -normalizing vectors H and G are then computed for 
use in the computation of the E matrix. The expression for this is: 

E = A T * P 

where P = row normalized A matrix with each element raised to the 
IALth power. The sign of each element remains the same as the un- 
powered element. 

Following this the transformation matrix to the oblique reference 
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vector structure matrix is computed by: 

B = B* E 

T 
where B on the right contains A .A. 

The transformation matrix is then formed by normalizing the columns 
of B. 

Once this transformation matrix is complete, it is applied to the A 
matrix to form the reference vector structure matrix. Also, multiplying 
it by its transpose produces the correlations among reference 
vectors. 

Upon entry to the program^array A contains the orthogonally rotated 
factor matrix from VARMX. 

Upon exit, A contains the oblique reference vector structure matrix, 
B contains the transformation matrix and E contains the correlations 
among reference vectors. The qommon variable KX(1) has been set 
equal to 1 for program RFOUT. 



SUBROUTINE NAME; RFOUT 

CALLING PROGRAM: FCTR3 

This subroutine is used to output the results of an orthogonal rotation and/ 
or compute and output the remainder of the matrices associated with 
an oblique rotation. The program determines whether the program 
preceding it was VARMX or PROMX by the common variable KX(I). 
If KX(I) = then VARMX preceded and RPRNT is called to output the 
transformation matrix and the orthogonal factor matrix. Before return- 
ing to the calling program, B is set to an identity matrix for possible 
factor score computation. 

If KX(I) = 1 then the preceding program was PROMX and different out- 
put and computational functions are performed by RFOUT. RPRNT is 
called to output the correlations among oblique reference vectors, (E), 
oblique reference vector structure matrix, (A), and the correlations 
among oblique reference vectors, (B). Matrix E is then inverted by 
MATIN and the reference vector pattern matrix computed and RPRNT 
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called to output this matrix. The correlations among reference vectors 
and primary factors are then computed and printed by RPR NO?. Using 
this result the correlations among primary factors are computed and 
presented. Finally, the primary factor structure matrix and primary 
factor pattern matrix are computed and presented. 

Upon entry KX(I) = if entry was from VARMX and A contains the 
orthogonal factor matrix, B the transformation matrix. 

When Kx(D = 1, A contains the oblique reference vector pattern matrix, 
B contains the transformation matrix and E contains the correlations 
among reference vectors . 

Upon exit from the program A will contain the primary factor pattern 
matrix and B, if from VARMX, will contain an identity matrix, or, if 
from PROMX, will contain the correlations among primary factors. 



SUBROUTINE NAME: RPRNT 
CALLING PROGRAM: RFOUT, SCORE 
This subroutine is used to print the following matrices: 

1 . Orthogonal transformation matrix 

2. Orthogonal factor matrix 

3. Transformation to oblique reference vector structure 

4. Oblique reference vector structure 

5. Correlations among oblique reference vectors 

6. Oblique references vector patterns 

7. Correlations between reference vectors and primary factors 

8. Oblique primary factor structure 

9. Correlations among oblique primary factors 

10. Oblique primary factor loadings 

11. Factor score regression coefficients 

This program has the same logic and structure as subroutine PRNT 
except for two minor differences . Column headings on printout are 
numerical sequence values and are not taken from the array VNAME . 
The second major difference is the meaning of the argument KODE . 
RPRNT will output either the common array A or B;if KODE = 0, then A 
will be printed with row headings taken from VNAME and columns in 
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generated numerical sequence . If KODE = 1 then the array B will 
be printed with generated numerical sequence for column and row 
headings . 

Matrix B or E contains the output matrix if KODE = 1 or the A array- 
contains the output matrix if KODE = 0. MID contains the matrix 
identification number, KODE = 1 or 0. MR is the number of columns 
of the output matrix. These are the exit conditions. 



SUBROUTINE NAME: MATIN 
CALLING PROGRAM: RFOUT, SCORE 
MATIN inverts a symmetric matrix. 



SUBROUTINE NAME: SCORE 



CALLING PROGRAM: FCTR3 



SCORE is used to compute the factor score regression coefficients 
and factor scores from either an oblique or orthogonal factor matrix. 
The program divides each element in the factor matrix A by l-X(I) 
where X(I) are the communalities for each row . The resultant matrix 
is stored in the last ten columns of the array A. 

The transpose of the original matrix multiplied by this matrix is then 
added to the B matrix. The B matrix contains either an identity matrix 
if the factors are orthogonal or the inverse of the intercorrelations of 
the primary factors and oblique factors. The resultant matrix B is 
then inverted by subroutine MATIN and the inverse multiplied by the 
modified A matrix to form the factor score regression coefficients. 
Subroutine RPR NT is then called to output this matrix. 

Factor scores are then computed from the regression coefficients by 
reading a data factor from the disk. If the problem number ID is posi- 
tive, each variable X(I) in the data vector is standardized by : 

Z (I) = (XClU - SUMY£fj )/SD(I) 
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where SUMY(I) contains the mean of the ith variable and SD(I) con- 
tains the standard deviation. The N elements of the standardized data 
vector Z are then multiplied by the N elements in each of the NFRT 
regression coefficients in A to form the factor scores for this data 
vector . The vector is then printed out with a sequence number and 
case identification ID. The title, job number and column headings 
are also printed on each page. 

If ID is negative the program will terminate and return to the main 
calling program. 

Upon entry to the subroutine matrix A contains the factor matrix. The 
raw data, followed by an artificial data vector with a negative identi- 
fication must be located on the disk. Matrix B will contain an identity 
matrix if the factors are orthogonal or the primary factor intercorrel- 
ations if the factors are oblique. The arrays SUMY and SD contain the 
means and standard deviations respectively. 

Upon exit the array A contains the factor score regression coefficients 
and the factor scores have been printed and/ or punched. 



SUBROUTINE NAME: XMAX 
XMAX computes the maximum of two arguments . 
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C. Routines Used by Regression and Factor Analysis 

LINK NAME: COREL 

CALLING PROGRAM: REGR and FCTR 

After initialization of switches and moving the sums of squares 
from the diagonal elements of the cross product matrix R to the vector 
SD for possible punchout, subroutine PRNT is called to examine MX(1) 
for either printing and/or punching the raw cross products matrix. 
From the raw cross products matrix, the residual cross products 
matrix is then computed by: 

R(I, J) = R(I, J) - SUMY(I) * SUMY( J)/CASES 

where: R(I, J) on the right hand side of the equal sign contains 

I, Jth raw cross products 

SUMY(I) contains the raw sum 

CASES contains the number of observations 

After the computation is completed, subroutine PRNT is then called 
for printing and/ or punching. 

From the residual cross product matrix, the variance-covariance 
matrix is computed by 

R(I, J) = R(I, J) /(CASES - 1) 

where: R(I, J) on the right contains the residual cross products and 
and CASES contains the number of observations. 

After the computation is completed, subroutine PRNT is again called 
for possible output. 

Once the variance-covariance matrix is computed the means and stan- 
dard deviations are computed by: 

SUMY(I) = SUMY(I)/CASES 

SD(I) = SQRT(R[I, I] ) 

A summary statistics table is then printed which contains the number 
of cases, variable names, high and low value of each variable, and 
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means and standard deviations. 

Once this printout is completed, the correlation matrix is computed 
by: 

R(I, J) = R(I, J) / (SD[l]*SD[Jl ) 

In the computation a test is made to determine if either SD(I) or SD(J), 
the standard deviation of the Ith and Jth variable respectively, is zero. 
If either one is zero, the correlation coefficient R(I, J) is set to zero 
and a message indicating which variable has the zero variance is 
printed . 

After the computation is completed, subroutine PRNT is again called 
to output the matrix. 

Upon entry to the program, CASE (the number of observations) , SUMY 
(the cumulative raw sums of each variable), and R(I, J) (the cumulative 
raw cross product matrix) have been either read in as matrices or 
accumulated previously. The high and low values of each variable are 
also present in the vectors HIGH and HLOW. 

Upon exit from the program the means, standard deviations, correlation 
matrix and sum of weights are in common storage at locations repre- 
sented by SUMY, SD, R, and CASES,respectively. 



SUBROUTINE NAME: PRNT 
CALLING PROGRAM: COREL, FCTR2 

Subroutine PRNT is used to print and/or punch the following six matrices: 

1. Matrix of raw cross products 

2. Matrix of residual cross products 

3. Variance -covariance matrix 

4. Matrix of correlation coefficients 

5. Matrix of characteristic vectors 

6. Principal axis factor matrix 

The program examines the output option array MX subscripted by the 
argument MID. If MX(MID) = 0, control will be returned to the calling 
program and no output will occur. If MX(MED) = 2 or 3, control will 
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be transferred to the punch routine and the matrix will be punched, 
5 elements to a card with identification indicating the problem number 
(IPROB), the matrix identification number (MID), the row of the matrix 
in which these 5 elements are located (I), and the column of the first 
element on the card (K). 

After the matrix has been punched MX(MID) is again examined to 
determine if it contains a value of 1 or 2. If it does not, the program 
will return to the calling program. However, if it does contain 1 or 2, 
the program will branch to the print routine . The print routine will 
print the title, page number, and job number followed by the name of 
the matrix as identified by MID. The matrix is printed, 8 elements to 
a line, with each column and row identified by a variable name as con- 
tained in VNAME . After the entire matrix is printed, control is 
returned to the calling program. 

There are four arguments used in the calling sequence to the subroutine . 
These have the following meaning: 

MID Matrix identification number 

KODE KODE is unused, but could be used for a switch 

allowing different formats . 
NR contains the number of rows in the matrix 

NC contains the number of columns in the matrix 

The matrix to be printed or punched is located in the common array R . 

On exit, the common variable NPAGE has been incremented by the 
number of pages required to print the entire matrix. There are no 
other changes to any other common locations . 



SUBROUTINE NAME: MX RAD 

■^ ™™" ■■HI >l Mil ■ „„ _,.,, , m 

CALLING PROGRAM: FCTR, REGR 

This subroutine is used by link FCTR and link REGR to read and/or 
add matrices . The program starts by reading a card containing the 
problem number(IP), matrix identification number (MID), the column 
number of the first data element on the card (IC), the row number (IR), 
and 5 data elements X(I), I = 1, 5. If IP is negative, the program 
branches to a termination routine which will set the common variable 
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NGASE to either a positive or negative value depending on whether the 
correlation matrix was processed. Control is then transferred to 
link FCTR or link RECR . 

If IP is positive and the row card is from a matrix other that 21 or 
22, the 5 elements X(I) are added to contents of the core matrix R, 
subscripted by IC and IR. If MID = 21, there is only one legitimate 
element on the row card, and this, added to the common variable 
CASES, is the number of observations. If MID = 22, there are only 
two legitimate elements on the row card, and these are added to 
the common vectors SUM and X. 

After the row card has been added to a matrix or vector (R, CASES, 
SUM or X) another card is read and the same process is initiated. 
Cards will be read until a negative problem number card comes up 
and the process is terminated, unless ICNST is non zero. If this is 
the case, a second matrix is accepted, and subtracted from those 
previously read. In this case, matrices should be raw cross products 
matrices . 

Upon entry to the program, the common variables R, NCASE, CASES, 
SUM and X have been set to zero. The variable ICNST is set to allow 
pooling. 

Upon exit, R, CASES, SUM, X have been set with input from the card 
reader. The variable NCASE has been made either positive or negative 
to determine logic flow in the main calling program . NCASE positive 
implies a raw cross products data set has been read and control will 
be passed to the correlation matrix generation program COREL. If 
NCASE is negative or zero, control will bypass COREL as a correlation 
matrix data set has been read. 
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D. Analysis of Variance 

LINK SUBROUTINES 



USE 



A NOVA 


Main Program 


Inputs parameter cards 
Inputs source data 


ANOV2 


SDOP 


Forms sums and deviates 




: MNSQ 


Forms sum of squares 




REPRT 


Forms mean square and 
output table. 



COMMON DATA STORAGE MAP - Analysis of Variance 



Name 


Dimension* 


Type 


Meaning 


ICR 


1 


I 


Card reader symbolic unit 


ICP 


1 


I 


Card punch symbolic unit 


IPR 


1 


I 


Print- Type switch 


IT1 


1 


I 


Not used 


IT2 


1 


I 


Not used 


IPROB 


1 


I 


Problem number 


NPAGE 


1 


I 


Page number 


INMD 


1 


I 


Input mode 


NF 


1 


I 


Number of factors 


ITR.N 


1 


I 


Transformation switch 


NA 


1 


I 


Number of levels +1 , Factor 1 


NB 


1 


I 


Number of levels +1, Factor 2 


NC 


1 


I 


Number of levels +1, Factor 3 


ND 


1 


I 


Number of levels +1 , Factor 4 


TITLE 


18 


F 


Page title 


NX 


p 


I 


Number of levels for each factor 


LS 


5 


I 


Temporary constants 


IN 


4 


I 


Data input array 


NDIV 


20 


I 


Divisors for sum of squares 


SMQR 


20 


I 


Summary vector for sum of squares 


XDEV 


20 


I 


Storage for deviates 


X 


1500 


F 


Data storage array 


ITW 


1 


I 


Output unit numbers 



The actual number of storage locations occupied by the common vari- 
ables depends on ;the variable type. An I, or integer variable, occupies 
1 location for each dimension, whereas an F, or floating point vari- 
able jOccupies 2 storage locations. 
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LINK NAME: A NOVA 



LOADED BY: // XEQ 



This link is used to read parameter cards and source data for analysis 
of variance. The program first reads an input-output units designa- 
tion card from the card reader. It then reads a title card and the 
analysis of variance parameter card. If the parameter INMD = 1 a 
variable format card is read and printed. 

After initializing the storage parameters for the number of factor 
levels the program reads a data record from either the card reader 
if INMD = 1, or from the disk if INMD = 2. The data record contains 
an index array IN and a data item. If the first index array item IN(1) 
is positive, the program will compute the storage location IS for this 
data item from the index array IN and the storage parameter LS. If 
the transformation switch is on, the transformation program will be 
called. Following this, the STORE program will be called to either 
store the data item DATA in storage or on disk. Following the return 
from program STORE, the program will branch back to read another 
data record. 

Upon exit from the program all the parameters are in common and all 
the required data has been stored either on the disk or in the array X. 
The condition for storing the data in-X is determined by the storage 
parameter IS. If IS is greater than 1500 the data will be stored on the 
disk; otherwise, in the array X. 



SUBROUTINE NAME: STORE, GET 

CALLING PROGRAM: ANOVA, SDOP, MNSQ 

These subroutines are used to store or get data either from the array 
X or disk. The programs test the argument IS? if IS is less than 1500 
the data will be stored or retrieved from, the core array X. If IS is 
greater than 1500 the item will be stored on the disk at storage location 
IS- 1500. After the item has been either stored or retrieved, control is 
returned to the calling program . 

On entry, DATA contains the item. 
IS contains the location parameter. 
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On exit, 

STORE - DATA has been stored in X or on the disk. 
GET - DATA has been retrieved from X or from the disk. 



LINK NAME: A.NOV2 



CALLED BY: ANOVA 



This program calls the remaining analysis of variance programs, 
SDOP, MNSQ, and REPRT, and exits to the monitor. 



SUBR OUTINE NAME: SDOP 

CALLING PROGRAM: ANOV2 

This subroutine is used to generate the analysis of variance sums and 
deviates for each factor. The program computes appropriate storage 
locations for the data and calls subroutine GET to obtain the data item 
for the Kth factor from either the array X or from the disk. Each data 
item is then summed over all levels for this factor and the sum locat- 
ed at SUMX is stored back in the array X at the appropriate location IS. 

After the sum is computed for the Kth factor the data array is again 
used to compute the analysis of variance deviate. Each element used 
to form SUMX is replaced by 

DATA = FN* DATA - SUMX 

where FN is the number of levels in the factor . 

After this computation, the storage pointers IS and ISPM are incre- 
mented and a test is made to determine the appropriate level . The 
factor count K is then incremented and computations are performed on 
the transformed data elements. After passing through the data the 
program returns to the main calling program 

Upon entry to the program all data items have been stored in either 
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the array X or on the disk. The number of levels for each factor is 
located in the array NX and the number of factors is located in NF. 

Upon exit from the program the data array (either X or disk) contains 
the sums and analysis of variance deviates. 



SUBROUTINE NAME: MNSQ 

CALLING PROGRAM: ANOV2 

This subroutine is used to compute the component and interaction sums 
of squares for the final analysis of variance table . After initiali- 
zation of the cumulation arrays, the program determines which com- 
ponent in the analysis of variance table is to be incremented for the 
current data item . The analysis of variance table SMQR can contain 
at most 15 values. These are related to the component and interaction 
sum of squares as follows: 

Index Component 

1 A 

2 B 

3 C 

4 D 

5 AB 

6 AC 

7 AD 

8 BC 
>9 BD 

10 CD 

11 ABC 

12 ABD 

13 ACD 

14 BCD 

15 ABCD 

where A, B, C, D are names of the factors. It should be noted that 
even if a particular job does not involve four factors, the subscript for 
the particular component is still the same. 

By passing through the data array (core and/or disk) in a sequential 
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manner, the program is able to determine which index value is re- 
quired for SMQR by testing the individual factor level counts IA, IB, 
IC, ID and comparing these to the number of levels in each factor, 
NA, NB, NC, ND. When the proper subscript is determined,K is 
set equal to this value and the program adds the square of the deviate 
to the appropriate cell in SMQR. When all deviates have been pro- 
cessed the program returns to the main calling program. 

On entry, the anaylsis of variance deviates are located either in the 
X array and/or on the disk. The number of levels in each factor are 
located in NA, NB, NC and ND. 

On exit, the component and interaction sums of squares multiplied 
by the component or interaction are located in SMQR. The deviates 
of interest are in XDEV and the divisor necessary to obtain the com- 
ponent sum of squares is located in NDIV. 



: SUBROUTINE NAME: REPRT 

CALLING PROGRAM: ANOV2 

This program is used to output the analysis of variance table. The 
program begins by setting up a general array for the degrees of free- 
dom. Next, the appropriate divisor and accumulation arrays are 
initialized, and the total sum of squares is computed. A card, con- 
taining a 24-character row heading (HEAD), a control indicator (INDI), 
and a component summary index array (INX) , is then read from the 
card reader. The index array, INX, is then used to subscript the 
SMQR array, which contains the component sums of squares. To 
add the appropriate elements to form the component to SMS.^ and 
degrees of freedom NDF1 after all emements of INX are chosen, 
the mean square SMSQM is computed by dividing the sums of 
squares by the degrees of freedom. Once this computation is com- 
pleted, a line is printed containing the sums of squares, degrees of 
freedom and mean square. If INDI is greater than zero, a page will 
be skipped and a title line with column headings will be printed before 
the component line. If INDI is negative the program will terminate 
by printing a residual line if necessary and/or total line. The residual 
is the difference between the total sum of squares computed in the 
beginning of the program and the sum of squares accumulated after 
each line has been printed. 
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On entry, except for the proper divisor, the component sums of 
squares are located in SMQR, and NDIV contains the divisor to com- 
pute the sums of squares . 

On exit, SMQR contains the component sums of squares and the re- 
quested component lines have been printed. 
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E . Orthogonal Polynomials 
The program contains the two links: 
LINK SUBROUTINES 



USE 



POLY 


Main Program 


Inputs parameter cards and 
source data 


POL2 


POLSQ 


Determines degrees and com 
putes orthogonal polynomials 




PCOEF 


Computes coefficients of 
fitted polynomial 




PDER 


Computes derivatives at a 
point 




PFIT 


Computes predicted Y for a 
given X . 



COMMON DATA STORAGE MAP - Orthogonal Polynomials 





Common 






Name 


Dimensions* 


"type. 


Meaning 


ICR 


1 


I 


Card reader symbolic unit 


ICP 


1 


I 


Card punch symbolic unit 


IPR 


1 


I 


Print- Type switch 


ITW 


1 


I 


Output unit numbers 


IT1 


1 


I 


Not used 


IT2 


1 


I 


Not used 


IPROB 


1 


I 


Problem number 


N 


1 


I 


Maximum degree of polynomial 


NF 


1 


I 


Actual degree of polynomial 


CASES 


1 


F 


Not used 


NPAGE 


1 


I 


Page number 


INMD 


1 


I 


Primary input mode 


ISCR 


1 


I 


Predicted values switch 


NCASE 


1 


I 


Number of data cases 


ICOF 


1 


I 


Coefficient computation switch 


IDER 


1 


I 


Derivative computation switch 


NDER 


1 


I 


Order of derivatives 


IALP 


1 


I 


Polynomial solution vector output 
switch 


INMD2 


1 


I 


Secondary input mode 


KX 


3 


I 


Not used 


EPS 


1 


F 


Tolerance criterion 



34 



FLVB 


4 


F 


Not used 


XB 


1 


F 


Scaling Constant 


X14 


1 


F 


Scaling Constant 


TITLE 


18 


F 


Page title 


ID 


150 


F 


Identification codes 


X 


150 


F 


Values of X 


Y 


150 


F 


Values of Y 


C 


51 


F 


Polynomial solution vector 


ALPHA 


51 


F 


Polynomial solution vector 


BETA 


51 


F 


Polynomial solution vector 


MF1 


50 


I 


Format for input data 



The actual number of storage locations occupied by the common 
variables depends on the variable type. An I, or integer variable, 
occupies 1 location for each dimension, whereas an F, or floating 
point variable, occupies 2 storage locations . 



LINK NAME: 



POLY 



LOADED BY: // XEQ 

This program is used to read parameter cards and source data for 
orthogonal polynomials. The program first reads an input-output 
units designation card from the card reader, followed by a title card 
and the orthogonal polynomials parameter card. If the parameter 
INMD = 1 or 3, a variable format card is read and printed. The pro- 
gram then branches to a special input section for each value (1, 2, or 
3) of the parameter INMD. 

If INMD = 1 the program will read the source data from the card reader. 
Each input record contains an identification field (ID £l\), a derivative 
computation indicator (IDF,), an X value X(I), and a Y value Y(I). If 
ID(I) is positive , the program will test IDR for non-zero. If zero, the 
program will read another card record; if non-zero, the identification 
for this record ID(I), will be made negative for examination by the 
program PDER. If ID(I) is negative, link POL2 is loaded and executed. 

If INMD = 2, the input data will be read from the disk instead of the 
card reader . It was placed there by the previous use of INMD = 1 . 

If INMD = 3, the polynomial solution vectors will be read into arrays 
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ALPHA, BETA, and C respectively, along with any necessary scaling 
constants . A branch is then made to the section corresponding to 
INMD = 1 in order to read the data points . 

Upon exit, the analysis parameters and data points are in common. In 
addition, if the parameter INMD2 ^ the polynomial solution vectors 
are in COMMON. If scaling was requested, scaling constants are also 
in COMMON. 



LINK: POL2 



CALLED BY: POLY 



POL2 calls the remaining programs in this analysis type if they are 
required, i.e., POLSQ for polynomials, PC OEF for coefficients, 
PDEF for derivatives, and PFIT for evaluation and prediction. 



SUBROUTINE NAME: POLSQ 

CALLING PROGRAM: POL2 

After initializing the computational parameters and accumulation arrays 
the program begins the main iteration loop by computing the first poly- 
nomial solution vector C by: 
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C(II) = 7R0 

where II is the current degree of the computed orthogonal polynomial, 

S is the inner product of Y and Ilth degree orthogonal polynomial, 
RO is the inner product of the polynomial with itself. 

Once S is computed the cumulative predicted values for 1 , 2 . . Ilth degree 
polynomials are computed and stored in array YA. The variance criterion 
for the cycle is then computed and compared to its value on the previous 
cycle . If the difference is approximately equal (within the tolerance 
EPS) it will transfer to the output routine and return to the main calling 
program . 
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If the variance criteria are not equal the next order polynomial will 
be computed utilizing the next order solution vectors ALPHA and BETA. 
After each order polynomial has been computed it is stored in the array 
POL. A test is made to determine if four polynomials have been stored. 
If so, the array POL is printed along with the input values contained in 
ID, X and Y. Also printed for each X(I), Y(I) are the cumulative pre- 
dicted values from YA(I) and their difference. 

The title information, job number, page number, and column headings 
are printed at the top of each output page . The current solution vectors 
are also printed at the bottom of each page . 

At the conclusion of the output stage, the current variance criterion 
is stored in the previous criterion location and the polynomial order II 
is incremented. The program then branches back to initiate another 
cycle . 

After either the variance criterion has been satisfied or the maximum 
degree of the polynomial (as determined by the user) has been reached, 
the program tests the input parameter IALP to determine if the final 
solution vectors are to be punched. If punching has been requested, the 
vectors are punched, with a matrix identification number, row and 
column number in. the standard matrix punch output format. Also, 
necessary scaling constants are punched. 

Upon entry to the program, the data is stored in array X and Y. The 
number of data cases are in location NCASE and all necessary common 
parameters are located in COMMON storage. 

On exit from the program, the solution vectors ALPHA, BETA and C 
are located in COMMON storage and the degree is that of the resultant 
polynomial which either satisfied the variance criterion or is the input 
parameter N which is located at NF. Arrays X, Y, ID and location 
NCASE have not changed. 



SUBROUTINE NAME: PCOEF 

CALLING PROGRAM: POL2 

This subroutine is used to compute the coefficients of the fitted 
polynomial from the polynomial solution vectors . 
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After initialization, the program computes orthogonal polynomials 
using the solution vectors ALPHA and BETA. From the orthogonal 
polynomial the coefficients of the fitted polynomial are computed by 
multiplying the solution vector C by this polynomial. This process 
continues until the degree NF+1 is reached. 

After the computation is completed, the coefficients are printed with 
title and heading information. 

Upon entry to the program the solution vectors are contained in arrays 
ALPHA, BETA and C. The degree of the polynomial is located at NF. 

Upon exit from the program, the polynomial solution vectors ALPHA, 
BETA and C are in common storage and the degree of the polynomial 
is at location NF. 



SUBROUTINE NAME: PDER 

CALLING PROGRAM: POL2 

This subroutine is used to compute the derivative of the fitted poly- 
nomial at a given point . The program begins by examining the identi- 
fication vector ID for a negative value. If ID(I) is positive, I is 
incremented and another identification value is examined. This will 
continue until I is equal to NCASE in which case control will be returned 
to the main calling program. 

If, for a given I, ID(I) is negative, the value of X for this I will be 
stored in XB and other derivative computations for this point started by 
initializing the computational arrays and parameters. The parameter 
NN represents the order of the derivative to be computed and is 
initially set equal to 1 . 

The program then computes the NNth order derivative by utilizing the 
polynomial solution vectors ALPHA, BETA and C to compute the 
orthogonal polynomial DOPOL. 

As each order polynomial is computed a recurrence solution is utilized 
to build up the value of the derivative and the next order . When NN is 
equal to NDD1, the order of the requested derivative, the program 
will print line or lines containing the identification ID(I), the value of 



38 



X(I), the value of Y(I), the order of the derivative and its value. Each 
page will also contain title and column headings. 

After the derivative for a point has been printed the program will 
transfer back to examine another ID(I) for a negative value . 

Upon entry to the program, the array ID contains identification values, 
X, Y contain data and ALPHA, BETA and C contain the polynomial 
solution vectors. NF contains the degree of the polynomial, NCASE the 
number of data points and NDER the order of the derivatives to be 
computed. 

Upon exit from the program the derivatives for all points indicated in 
the ID vector have been printed, and the polynomial solution vectors 
ALPHA, BETA and C are in their respective arrays. 



SUBROUTINE NAME: PFIT 

CALLING PROGRAM: POL2 

This subroutine is used primarily to compute predicted values from 
a set of data values X(I) that are different than those used to compute 
the initial polynomial. After initialization the program uses the solu- 
tion vectors ALPHA, BETA and C to compute orthogonal polynomials. 

As each order orthogonal polynomial is generated the cumulative pre- 
dicted value is computed from X(I) and stored in the array YA. After 
NCASE values of YA are computed the program will print the predicted 
values, with identification, the actual value of Y, and the difference. 
Title and column headings will also appear on each page. 

Upon entry to the program the solution vectors are in ALPHA, BETA and 
C . The data points are located in X and Y and the degree of polynomial 
is in NF. The number of data points is located at NCASE. 

Upon exit from the program the predicted values for all data points 
have been printed. 
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F. Routines Used by All System Programs 

The following five routines in assembly language allow user -specified 
format statements at object program time. Of the routines called by 
these, CARDZ, PRNTZ, NORM, IFIX, TYPE Z, and FSTOX are 
utility routines available to the assembler. 

SUBROUTINE FMTRD 

FMTRD reads one card containing a format and stores it in a form 
suitable for the subroutine DATRD. 

Calling sequence: 

CALL FMTRD (FORMT, ERROR) 

FORMT must be an integer vector fifty (50) words long. ERROR is an 
integer word. 

Upon return, FORMT contains the translated format and ERROR will 
be zero. If the translation was completed, ERROR will be the next 
column to be processed if an error was detected. When an error is 
detected no attempt is made to complete the translation and format 
may have to be changed. 

Format codes: The following specifications are acceptable: 

wX nlw nFw.d nEw.d 

n may be omitted if it is one . One level of parentheses is allowed 
for group repetition. In addition, parentheses are required around 
the entire format. Every specification, including wX and parenthesized 
groups, must be followed by either a comma or a right parenthesis. 
Multiple record formats (/), scaling (P) and alphabetic conversion 
(A, H and I) are not available. In addition, the format must be com- 
pleted on one card. 

Length: 225 

Subroutines required: CARD Z 
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SUBROUTIN E PRNTB 

PR NIB prints the I/O buffer after a previous read statement. 

Calling sequence: 

CALL PRNTB 

Function and use: When called, PRNTB prints the first eighty positions 
of the I/O buffer on the printer with a double space . It may be used 
after a call to FMTRD or DATRD, whether or not an error occured, 
to print the card just processed. It may also be called after a normal 
card read statement. No I/O statements may intervene between a 
call to PRNTB and the associated read statement. 

Length: 16 

Subroutines used: PR NT Z, TYPE Z 



SUBROUTINE DATRD 

DATRD reads one card of data according to a format previously 
stored by FMTRD. 

Calling sequence: CALL DATRD (FORMT, ERROR, VAR1, Nl, VARZ, 
NZ, ..., 0, 0) 

FORMT is an integer vector fifty words long previously named in a 
call to FMTRD. ERROR is an integer word. VAR1, VAR2, etc. are 
integer or real variables or vectors. Nl, N2, etc. are integer vari- 
ables or constants. Each is positive if the corresponding variable is 
integer, negative if real. 

Upon return, the first Nj locations of each VARj_ are replaced 

by data. Automatic type conversion from I specification 

to real and from E or F specification to integers is performed. If no 

error is detected, ERROR is set to zero; otherwise it is set to the 

next column to be processed. The error is either in the specified 

column or in the preceding field. None of the N. may be zero. Two 

zeros end the list of variables. 

Data: Only one data card can be read by this routine . An attempt to 
read beyond the end of the format is treated as an error. Numbers 
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may have any number of leading or trailing blanks . Signs may have 
leading and trailing blanks . If the sign is omitted, it is assumed to 
be positive . For F and E conversions, a decimal point is allowed; if 
omitted it is implied by the format. E type numbers may have an 
exponent part which must start with an E, a blank or a sign. Blanks 
may not precede the E . If the exponent minus the number of decimals 
(explicit or implicit) is not in the range £ 63, an error is indicated. 
If the absolute value of the number ignoring the decimal point and 
exponent is greater than 2^1-1, the result will be incorrect with no 
error indication given. An overflow or underflow condition is possible 
and is ignored. 

Length: 350 

Subroutines required: CARDZ, NORM, GMPYX, GDIVX, IFIX, 

FSTOX 



SUBROUTINE NAME: GMPYX 

GMPYX is equivalent to EMPYX, from the IBM 1130 FORTRAN 
Library . 



SUBROUTINE NAME: GDIVX_ 

GDIVX is equivalent to EDIVX, from the IBM 1130 FORTRAN 
Library . (GMPYX and GDIVX are required by DATRD in a form 
accessible to assembly language routines.) 

The following routine is written in FORTRAN. 



SUBROUTINE NAME: FMAT 

FMAT is called to allow correct output from the typewriter or printer; 
when a format statement is handled by the typewriter, the carriage 
control character is printed unless FMAT is used. 
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The following routine is called on user option by each of the four system 
programs. It is included to aid the user in preparing a program for 
variable transformation. The User's Manual which is distributed with 
the 1130 Statistical System discusses such a program. 

SUBROUTINE TRAN 

TRAN is a user written subroutine which currently returns to the calling 
program. 
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4. PROGRAMMING NOTES 

An experienced system user may desire to modify sections of the 
package. For example,larger arrays could be analyzed by modifying 
dimension statements, primarily those evident in COMMON. Such revision 
may be desirable in Regression and Factor Analysis, and may require that 
the number of main linkages be increased, to provide adequate storage 
facilities. In Orthogonal Polynomials, if scaling is used, and the user 
desires the original coefficients for his polynomial, those for X, rather 
than X', another link could be written to provide these.. Considerable care 
should be taken concerning accuracy, so that the same problems do not 
arise that were bothersome in the unsealed situation. 



In Factor Analysis, if the user retains the correlation matrix by 
saving it on the disk throughout the calculation, then factor scores could 
be calculated by the direct method, rather than the short method. The 
short method only calls for Inversion of an m-by-m matrix, where m is 
the number of factors rotated. Modifications to allow direct estimation 
will require revision of links FCTR1, FCTR2, and FCTR3. 



The following table gives core requirements for each program in 
the 1130 Statistical System using the 1130 Disk Monitor System, Mod. Level 2. 



Program Variables ; 


Common 


Program 


Total 


FMTRD, 


PRNTB 








DATRD, 


GMPY 








GDIV 








578 


TRAN 








4 


4 


MXRAD 


14 


2142 


234 


2390 


COREL 


24 


2262 


656 


2942 


PRNT 


8 


2142 


668 


2818 


PCOEF 


14 


1540 


292 


1846 


POLY 


32 


1182 


1024 


2238 


POL2 


8 


3232 


62 


3302 


POLSQ 


40 


3232 


1042 


4314 


PFIT 


14 


2032 


318 


2364 


PDER 


24 


1438 


432 


1894 


REGR 


24 


2412 


1378 


3814 


REGR2 


8 


2262 


48 


2318 


REG RE 


112 


2262 


1902 


4276 


ANOVA 


28 


3166 


724 


3918 


STORE 


2 


3166 


44 


3212 


GET 


2 


3166 


42 


3210 


ANOV2 


14 


4166 


44 


4224 


SDOP 


16 


3166 


206 


3388 
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Program 


Variables 


Common 


Program 


Total 


MNSQ 


10 


3166 


348 


3524 


REPRT 


34 


3206 


690 


3930 


FCTR 


30 


2412 


1782 


4224 


FCTR1 


20 


2264 


252 


2536 


INVBS 


10 





322 


332 


XMAX 


2 





28 


30 


TRIDI 


156 


2264 


826 


3246 


OR 


154 


2264 


638 


3056 


FCTR2 


88 


2264 


480 


2832 


RFOUT 


6 


1342 


596 


1944 


PROMX 


12 


1362 


578 


1952 


VARMX 


76 


1142 


1068 


2286 


VECTR 


136 


2264 


530 


2930 


GOVEG 


196 


2264 


322 


2782 


FCTR3 


14 


1362 


66 


1442 


RPRNT 


8 


942 


808 


1758 


MATIN 


72 





482 


554 


SCORE 


16 


1162 


822 


2000 


FMAT 








34 


34 
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5. LIST OF SWITCHES 



One console entry switch is used by the 1130 Statistical System. If 
switch 15 is off (down), then each time a program punches cards, a 
message reminds the user to supply blank cards. This reminder can 
be suppressed by turning switch 15 on (up). 
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6.0 PROGRAM LISTINGS 
// ASM 



READ VARIABLE FORMAT 

* READ AND DECODE FORMAT CARDS 



ENT 






LPREN 


DC 








BSI 




READ 




DC 




.[ 




MDX 




*+l 




MDX 




**3 




3SI 




READ 




DC 




.( 




MDX 




*+2 




MDX 


L 


LPREN, 1 




BSC 


I 


L°REN 


RPREN 


DC 








BSI 




READ 




DC 




.) 




MDX 




*+l 




MDX 




*t-3 




BSI 




READ 




DC 




.) 




MDX 




*<-2 




MDX 


L 


RPREN, 1 




BSC 


I 


RPREN 


FMTRD 


DC 








STX 


1 


FMTEX-1 




STX 


2 


FMTEX-3 




STX 


3 


FMTEX-5 




LD 




ZERO 




LIBF 




CARDZ 




LDX 


11 


FMTRD 




LD 


1 







A 




ONE 




STO 




STORE-2 




LD 


1 


1 




STO 




FMTEX-7 




MDX 


1 


2 




STX 


1 


FMTEX+1 




LDX 


1 


/3C 




LDX 


2 


-51 




LD 




MUL 




STO 


1 


30 


BEGIN 


BSI 




LPREN 




MO" 




FMTER 




LD 




AD5 




BSI 




STORE 


ELEM 


BSI 

NOP 




NUMBR 




BSI 




LPREN 




MDX 




ELEN-2 




LD 




NUM 



FMRD 





FMRD 


10 


FMPD 


20 


FMRD 


30 


FMRD 


40 


FMRD 


50 


FMRD 


60 


FMRD 


TO 


FMRD 


80 


<=MRD 


90 


FMPD 


100 


FMRD 


110 


FMRD 


120 


FMRD 


130 


FMRD 


140 


FMRD 


150 


FMRD 


160 


FMRD 


170 


FMRD 


180 


FMRD 


190 


FMRD 


200 


FMRD 


210 


FMRD 


220 


FMRD 


230 


FMRD 


240 


FMRD 


250 


FMRD 


250 


FMRD 


270 


FMRD 


280 


FMPD 


290 


FMRD 


300 


FMRD 


310 


FMRD 


320 


FMRD 


330 


FMRD 


340 


FMRD 


350 


FMRD 


360 


FMPD 


370 


FMRD 


380 


FMRD 


390 


FMRD 


400 


FMRD 


410 


FMRD 


420 


FMRD 


430 


FMRD 


440 


FMRD 


450 


FMRD 


460 


FMRD 


470 


FMRD 


480 


FMRD 


490 


FMRD 


500 


FMRD 


510 


FMRD 


520 


FMRD 


530 


FMRD 


540 



EOR 




ONE 


STO 




sn 


SSC 


L 


REP,+- 


FOR 




AD2 


BSI 




STORE 


STX 


2 


HOLD 


REP BSI 




MUMBR 


NOP 






BSI 




SPCIF 


MDX 




FMTFR 


BSI 




READ 


DC 




• » 


MDX 




*+l 


MDX 




REP 


BSI 




RPREN 


MDX 




FMTER 


LD 




SW 


BSC 


L 


ELEN,+- 


LD 




AD3 


A 




HOLD 


BSI 




STORE 


MDX 




ELEM 


BSI 




SPCIF 


MDX 




FMTER 


ElEN BSI 




READ 


DC 




• , 


MDX 




*+l 


MDX 




ELEM 


BSI 




RPREN 


MDX 




FMTER 


LD 




A04 


BSI 




STORE 


LDX 


1 





STX 


LI 




LDX 


L3 




LDX 


L2 





LDX 


LI 





FMTEX BSC 


L 


n 


* 






READ DC 






BSI 




GETCL 


LDX 


13 


READ 


EOR 


3 




BSC 


L 


*+2iZ 


MDX 


1 


1 


MDX 


3 


1 


BSC 


L3 


1 


* 






STO 


L2 




BSC 


L 




STORE EQU 




*-l 


MDX 


2 


1 


MDX 




STORE-3 


* 






FMTER MDX 


1 


1-/3C 



FMRD 550 
FMRD 560 
FMRD 570 
FMRD 580 
FMRD 590 
FMRD 600 
FMRD 610 
FMRD 620 
FMRD 630 
FMPD 640 
FMRD 650 
FMRD 660 
FMRD 670 
FMRD 680 
FMRD 690 
FMRO 700 
FMRD 710 
FMRD 720 
FMRD 730 
FMRD 740 
FMRD 750 
FMRD 760 
FMRD 770 
FMPD 780 
FMRD 790 
FMRD 800 
FMRD 810 
FMRD 820 
FMRD 830 
FMRO 840 
FMRD 850 
FMRD 860 
FMRD 870 
FMRD 880 
FMRD 890 
FMRD 900 
FMRD 910 
FMRD 920 
FMRD 930 
FMRD 940 
FMRD 950 
FMRD 960 
FMRD 970 
FMRD 930 
FMRD 990 
FMRD1000 
FMRD1010 
FMRD1020 
FMRD1030 
FMRD1040 
FMRD1050 
FMRD1060 
FMRD1070 
FMRD1080 
FMRD1090 



MDX 



FMTEX-8 



CO 



NUM DC 

401 DC /3081 

AD2 DC /0101 

AD3 DC /P180+51 

AD4 DC /0200 

OPO DC 

0P1 DC /4000 

QP2 DC /3000 

0P3 DC /COOO 

ONE DC L 

WORK DC 

AD5 DC /0281 

SW DC 

HOLD DC 

ZERO EO.U OPO 

NUL EQU ZERO 

CHZER DC .0 

BLNK DC 

NUMBR DC 

LD OME 

STD N'JM 

BSI DIGIT 

MDX NUMEX 

STO N'JM 

BSI DISIT 

MDX NUMEX-3 

LD NUM 

SLA 7 

A NUM 

SLA 1 

A DIG 

STO NUM 

LD NUM 
MDX L NUMBR, 1 

NUMEX BSC I NUM3R 

* 

SPCIF DC 

BSI READ 

DC .X 

MDX *+2 

LD OPO 

MDX SPCEX-4 

LD NUM 

EOR ONE 
8SC L *+2,+- 

EOR AD1 

BSI STORE 

BSI READ 

DC -I 

MDX *+5 

BSI NUMBR 

MDX =MTER 



FMRDUOO 
FMRD1110 
FMRDU20 
FMRD1130 
FMRD1140 
FMRDU50 
FMR01160 
FMRD1170 
FMRD1180 
FMRD1190 
FMRD1200 
FMRD121D 
FMRD1220 
FMRD1230 
FMRD1240 
FMRD1250 
FMRD1260 
FMRD1270 
FMRD12S0 
FMR01290 
FMR0130D 
FMRD1310 
FMRD1320 
FMPD1330 
FMRD1340 
FMRD1350 
FMRO1360 
FMRD1370 
FMRD1380 
FMRD1390 
FMRD1400 
FMRD1410 
FMRD1420 
FMR01430 
FMRD1440 
FMRD1450 
FMRD146C 
FMRD1470 
FMRD1480 
FMRD1490 
FMRD1500 
FMRD1510 
FMRD1520 
FMRD1530 
FMRD1540 
FMRD1550 
FMRD1560 
FMRD1570 
FMRD1580 
FMRD1590 
FMRni600 
FMPD161C 
FMRD1620 
FMRD1630 
FMRD1640 



SLA 7 

OR DPI 

MDX SPCEX-3 

BSI READ 

DC .F 

MDX *+2 

LD 0P2 

MDX *+<t 

BSI READ 

DC .E 

MDX SPCEX 

LD 0P3 

STO WORK 

BSI NUMBR 

MDX FMTER 

SLA 7 

OR WORK 

STO WORK 

BSJ READ 
DC 

MDX FMTER 

BSI NUMBR 

MDX FMTER 

LD WORK 

OR NUM 

BSI STORE 
MDX L S°CIF,l 

SPCEX BSC I SPCIF 

* 

GETCL DC 

LD 10 

EOR BLNK 

BSC L *+2,Z 

MDX 1 1 

MDX GETCL+1 

EOR BLNK 

BSC I GETCL 

* 

DIG DC 

DIGIT BSS 1 

BSI GFTC4_ 

S CHZER 
BSC L DIGEX.+Z 

STO DIG 
MDX 1 I 
MDX L DIGIT, 1 

DIGEX BSC I DIGIT 
END 



// OUP 

*STORE 



WS UA FMTRD 



FMRD1650 
FMRD165D 
FMRD1670 
FMRD16R0 
FMRD1690 
FMRD1700 
FMRD1710 
FMRD1720 
FMRD1730 
FMRD1740 
FMRD1750 
FMRD1760 
FMPD1770 
FMRD1780 
FMRD1790 
FMRD1800 
FMRD1910 
FMRD1920 
P MPD1 9 30 
FMRD1840 
FMRD1850 
FMRD1860 
FMRD1370 
FMR018SO 
FMRD1890 
FMRD1900 
FMR01910 
FMRD192P 
FMRD1930 
>=MRD1940 
FMPD1950 
FMRD1960 
FMRD1970 
FMRD1980 
FMPD199C 
FMRD2000 
FMRD2010 
FMRD2020 
FMPD2030 
FMRD234D 
FMPD2050 
FMRD2D60 
FMRD2370 
FMRD2080 
FMRD20 Q 
FMR0210D 
FMPD211D 
FMRO2120 
FMPD2130 
FMRD2140 



// ASH 



* PRINT 1-0 BUFFER (80 CHARACTERS, D0U8LF SPACE) 

* PRINT 1-0 BUFFER (80 CHARACTERS, DOUBLE SPACE! 



// DUP 
♦STORE 



ENT 

PRNTB DC 
STX 
LDX 
LD 
STO 
MOX 
MDX 
LD 
STO 
LDX 
LIBF 
LOX 
8SC 
DC 
END 



SVE 
CM 



03WS UA PRNTB 






ORNTB 



SVE + 1 

80 

/3C-1 

/3C 

-1 

*-4 

CN1 

/3C 

81 

PRNTZ 

PRNTB 

.0 




10 
20 
30 
40 
50 
60 
70 
SO 
90 



PRNB 

ORNB 

PRNB 

PRNB 

PRNB 

PRNB 

PRNB 

PRNB 

PRNB 

PRNB 

PRNB 100 

PRNB 110 
PRNB 120 

PRNB 130 
PRNB 140 
PRNB 150 
PRNB 160 
PRNB 170 
PRNB 180 
PRM8 190 
PRNB 200 
PRNB 210 



// ASH 



* READ DATA ACCORDING TO FORMAT STATEMENT 

* READ DATA ACCORDING TO FORHAT STATEMENT 



ENT 




DATRD 


DBL A 


12 1 


STO 




3 125 


A 




2 


STO 




*+? 


SLA 




15 


S 




3 125 


STO 


L 


1 


BSI 




FHTEN 


MDX 




DATER 


LIRF 




FSTGX 


DC 







MDX 


I 


. -2 


MDX 




*-6 


MDX 




LIST 


DATER MDX 


2 


2 


LD 


12 


' 1 


BSC 


L 


DATER, Z 


LD 




COJL« + I 


S 




CN1 


MDX 


2 


2 


STX 


2 


DATEX+1 


STO 


L 





LDX 


L2 





LDX 


LI 





DATEX BSC 


L 





DATRD DC 






STX 


1 


DATEX-1 


STX 


2 


DATEX-3 


SRA 




16 


STO 




SPEC+1 


LDX 


I 


/3C 


STX 


1 


CDLH+1 


STC 


1 


80 


LIBF 




CARDZ 


LDX 


12 


DATRD 


LD 


2 





STO 




S»EC+3 


HDX 


L 


S°EC+3,-49 


LD 


2 


1 



STD 



DATEX-5 



LIST MDX 2 ? 



LD 


12 


1 


8SC 


L 


DATEX-8,<- 


BSC 


L 


DBL.+ 


STO 


L 


1 


LD 


2 





S 


L 


1 




10 
20 
30 
40 
50 
60 
70 
80 
90 



DTRO 
DTRD 
DTRD 
DTRD 
DTRD 
DTPD 
DTRD 
DTRD 
DTRD 

DTRD 

DTRD 100 
OTRD 110 
DTRD 120 
DTRO 130 
DTRD 140 
DTRD 150 
DTRD 160 
OTRD 170 
OTRD 130 
DTRD 190 
DTRD 200 
DTRD 210 
OTRD 220 
DTRD 230 
DTRO 240 
DTRD 250 
DTRD 260 
OTRD 270 
DTRD 280 
DTRD 290 
DTRD 300 
DTRD 310 
DTRD 320 
DTPD 330 
DTRO 340 
DTRD 350 
DTRD 360 
DTRD 370 
DTRD 380 
DTRD 390 
DTRD 400 
DTRD 410 
DTRD 420 
DTRD 430 
DTRD 440 
DTRD 450 
DTRD 460 
DTPD 470 
DTRD 480 
DTRD 490 
DTRD 500 
DTRD 510 
DTRD 520 
DTRD 530 
DTRD 540 





STO 




*+4 




B5I 




FMTEN 




MDX 




DATER 




LIBF 




IFIX 




STO 


LI 







MDX 


1 


-1 




MDX 




*-7 




MDX 




LIST 


* 








CN1 


DC 




/3C-1 


XR1 


DC 






XR2 


DC 






* 








MISC 


LDX 


LI 


BRTB*4 




SLA 




9 




SLT 




7 




BSC 


11 




WIDTH 


EQU 




*-l 


XTYPE 


A 




C3LM+1 




STO 




CQLM+1 




MDX 




SPEC 


AXT1 


STO 




XR1 




MDX 




SPEC 


AXT2 


STO 




XR2 




MOX 




SPEC 


TIX2 


MDX 


L 


XR2.-1 




STO 




SPEC + 1 


Cn 
O 

INI T 


MOX 




SPEC 


EQU 




AXT1 


FMTEN 


DC 








STX 


1 


FMTEX+l 




STX 


2 


FMTEX+3 


SPEC 


LDX 


LI 






LD 


LI 







MDX 


L 


XRl.-l 




MDX 




*<-3 




MDX 


L 


XR1, 1 




MDX 


1 


1 




STX 


1 


SPEC+1 




SRT 




14 




STO 


L 


1 




SLA 




9 




SLT 




7 




STO 




WIDTH 




BSC 


11 


BRTB+2 


GETCL 


DC 








LD 




WIDTH 




BSC 


L 


*+4,+ 


COLM 


LD 


L 






MDX 


L 


GETCL, 1 


* 

3LNKS 


BSC 


T 


GETCL 


DC 








BSI 




GETCL 



DTRD 550 
DTRD 560 
DTRD 570 
DTRD 580 
DTRD 590 
DTRD 600 
DTRD 610 
DTRD 620 
DTRD 630 
DTRD 640 
DTRD 650 
DTRD 660 
DTRD 670 
DTRD 680 
DTRO 690 
DTRD 700 
DTRO 710 
DTRD 720 
DTRD 730 
DTRD 740 
DTRD 750 
DTRD 760 
DTRD 770 
DTRO 780 
DTRD 790 
DTRD 800 
DTRD 810 
DTRD 820 
OTRD 830 
DTRD 840 
DTRD 850 
DTRD 860 
DTRD 870 
DTRD 880 
DTRD 890 
DTRD 900 
DTRD 910 
DTRO 920 
DTRD 930 
DTRD 940 
DTRD 950 
DTRD 960 
DTRD 970 
DTRD 980 
DTRD 990 
DTRD1000 
DTRD1010 
DTRD1020 
DTPD1030 
DTRD1040 
DTRD1050 
DTRD1060 
DTRD1070 
DTRD1080 
DTRD1090 





ny 




*+5 




EOR 




BLNK 




BSC 


I 


BLNKS,Z 




BSI 




STPCL 




MDX 




BLNKS+1 




MOX 


L 


BLNKS.l 




MDX 




8LNKS+3 


BLNK 


DC 






* 








STPCL 


DC 








MDX 


L 


COLM+1,1 




MDX 


L 


WIDTH, -1 




MOP 








BSC 


I 


STPCL 


* 








CHZER 


DC 




.0 


IMUMEX 


DC 








BSI 




GETCL 




MDX 


m 


NUMXX 




S 




CHZER 




BSC 


L 


NUMXX, +Z 




STO 




DIG+1 




BSI 




ST»CL 


CNTSW 


MDX 


L 


COUNT, 




LDD 




NUM 




SLT 




2 




AD 




NUM 




SLT 




1 


SGN 


AD 




DIG 




STD 




NUM 




MDX 




NUMEX+1 


NUMXX 


BSC 


I 


NUMEX 




STO 




COUNT 


OP 


DC 








DC 




TASLE+18 




LD 




COUNT 




MDX 




SCL<-2 


SCALE 


LD 




EDIVX 




STO 




OP 




LD 




COUNT 




BSC 


L 


*+4,- 




LD 




EMPYX 




STO 




OP 




LD 




ZERO 




S 




COUNT 




LDX 


1 


-18 


SCL 


BSC 


L 


0P-1,E 




SRA 




1 




MDX 


1 


3 




MDX 




SCL 




BSC 




+ 


CMMN 


BSI 




BLNKS 




MDX 




FMTEX 




MDX 


L 


FMTEN, 1 



DTRD1100 

DTRD1U0 

DTRD1120 

DTRD1130 

DTRD1140 

DTRD1150 

DTPD1160 

DTRD1170 

DTRD1180 

DTRD1190 

DTR01200 

DTRD1210 

DTRD1220 

DTRD1230 

DTRD1240 

DTRD1250 

DTPD1260 

DTRD1270 

DTRD1280 

DTRD129P 

DTR01300 

DTRD1310 

DTRD1320 

DTRD1330 

DTRD1340 

DTRD1350 

DTRD1360 

DTRD1370 

DTRD1380 

DTRD1390 

DTRD1400 

DTRD1410 

DTRD1420 

DTRD1430 

DTRD1440 

DTRD1450 

DTRD1460 

DTRD1470 

DTRD1480 

DTRD1490 

DTRD1500 

DTRD1510 

DTP01520 

DTR01530 

DTRD1540 

DTRD1550 

DTRD1560 

DTRD1570 

DTRD1580 

DTRD1590 

DTPD1600 

DTRD1610 

DTR01620 

DTRD1630 

DTRD1640 



FMTEX LDX LI 

LOX L2 

BSC I FMTEN 

HLT EQU FMTEX 



Ol 



DIG 


DEC 







ZERO 


DEC 







READ 


DC 








LDX 


12 


READ 




BSI 




GETCL 




MOX 




**5 




EOR 


2 







BSC 


L 


*+2tZ 




BSI 




STPCL 




MDX 


2 


1 




BSC 


L2 


1 


NUM 


DEC 









MDX 


L 


NUMSR.l 




BSC 


L 




NUMBR 


EQU 




*-l 




BSI 




8LNKS 




NOP 








LDD 




ZERO 




STD 




NUM 




LD 




SWOFF 




STO 




CNTSW 




BSI 




NUMEX 




BSI 




READ 




DC 








MDX 




NUMBR-3 




STO 




COUNT 




LD 




SWON 




STO 




CNTSW 




BSI 




NUMEX 




MDX 




NUMBR-1 


* 








EMPYX 


LIBF 




GMPYX 


EOIVX 


LIBF 




GD I V X 


COUNT 


DC 






SWON 


DC 




/7401 MDX 


ISWOF 


NOP 






I SWON 


MDX 


X 


FMTEX-ISW-1 


EXP 


DC 




159 


SWOFF 


DC 




/4C38 BSC 


* 








ETYPE 


LD 




[SWOF 




BSI 




FFIX 




BSI 




READ 




DC 




• E 




MDX 




*+3 




BSI 




SIGN 




NOP 








MDX 




*+2 



,+z- 



DTRD1650 
DTRD1660 
DTRD1670 
DTRD16RO 
DTRD1690 
DTRD1700 
DTRD1710 
DTRO1720 
DTRD1730 
DTR01740 
DTRD1750 
DTRD1760 
DTRD1770 
DTPD1780 
DTR01790 
DTRD1800 
DTRD1810 
DTRD1820 
DTRD1830 
DTRD1S40 
DTR01850 
DTRD1860 
DTRD1870 
DTRD1880 
DTRD1890 
DTRD1900 
DTRD1910 
DTRD1920 
DTRD1930 
DTRD1940 
DTRD1950 
0TRD1960 
DTRD1970 
DTRD1980 
OTRD1990 
DTRD2000 
DTRD2010 
DTRD2020 
DTRD2030 
DTRD2040 
DTRD2050 
DTRD2060 
DTRD2070 
DTRD2080 
DTRD2090 
DTRD2100 
OTRD2110 
DTRD2120 
0TRD2130 
DTRD2140 
DTRD2150 
DTRD2160 
DTRD2170 
DTRD2180 
DTRD2190 





BSI 


SIGN 




MDX 


SCALE 




BSI 


NUMBR 




MDX 


FMTEX 




LD 


COUNT 




S 


NUM+1 




STO 


COUNT 




MDX 


SCALE 


* 






ITYPE 


LD 


ISWON 




MOX 


FTYPE-H 


FTYPE 


LD 


ISWOF 




BSI 


FFIX 




MDX 


SCALE 


* 






PLUS 


AD 


X DIG-SGN-1 


MINUS 


SD 


X DIG-SGN-1 




LD 


MINUS 




STO 


SGN 




LDX 


1 1 




BSC 


LI 


SIGN 


EQU 


*-l 




LD 


PLUS 




STO 


SGN 




LDX 


1 




BSI 


READ 




DC 


. 




MDX 


*+2 




LDX 


1 1 




MDX 


*-5 




BSI 


READ 




DC 


.+ 




MDX 


*+l 




MDX 


SIGN-2 




BSI 


READ 




DC 


.+ 




MDX 


*+L 




MDX 


SIGN-2 




BSI 


READ 




DC 


.- 




MDX 


SIGN-1 




MDX 


SIGN-4 


* 






FFIX 


DC 






STO 


ISW 




SLA 


9 




SLT 


7 




STO 


COUNT 




BSI 


SIGN 




NOP 






BSI 


NUMBR 


ISW 


MDX 


FMTEX 




LDD 


NUM 




STD 


3 126 




LD 


EXP 



DTRD22P0 
DTRD2210 
DTRD222C 
DTRD2230 
DTRD2240 
DTRD2250 
DTRD2260 
DTRD2270 
DTR 02280 
DTRD229C 
DTRD230C 
DTRD2310 
DTRD2320 
DTRD2330 
DTRD2340 
DTRD2350 
DTRD2360 
OTR02370 
DTRD2380 
DTRD2390 
DTRD2400 
DTR02410 
0TRD2420 
DTRD2430 
DTRD2440 
DTRD2450 
DTRD2460 
DTRD247C 
DTR02480 
DTR02490 
DTRD2500 
DTR02510 
DTRD2520 
DTRD2530 
DTRD2540 
OTRD2 550 
DTPD2560 
DTRD2570 
DTRD2580 
DTPD2590 
DTRD2600 
DTRD2610 
DTRD2620 
DTRD2630 
DTRD2640 
DTRD2650 
DTRD2660 
DTRD2670 
DTRD2680 
DTRD2690 
DTRD2700 
DTRD2710 
DTRD2720 
DTRD2730 
DTRD2740 








STO 


3 125 




LIBF 


NORM 


FFIXX 


BSC 


I FFIX 


* 






BRTB 


DC 


FTYPE 




DC 


ETYPE 




DC 


MISC 




DC 


ITYPE 




DC 


XTYPE 




DC 


AXT1 




DC 


AXT2 




DC 


TIX2 




DC 


HLT 




DC 


iNIT 


TABLE 


DC 


/0084 




DC 


/5000 




DC 


/OOOO 




DC 


/0037 




DC 


/6400 




DC 


AOOOO 




DC 


/003E 




DC 


/4E20 




DC 


/OOOO 




DC 


/0Q9B 




DC 


/5F5E 




DC 


/lOOO 




DC 


/00B6 




DC 


/4TOD 




DC 


/E4E0 




DC 


/OOEB 




DC 


A4EE2 




oc 


/D604 




END 





// DUP 

*STORE 



'AS UA DATRD 



10. EOl, TRUNCATED 
10. E02, TRUNCATED 
10. E04, TRUNCATED 
10. EOS, TRUNCATED 
10. E16, ROUNDED 
10. E32, TRUNCATED 



DTRD275C 
DTRD2760 
DTRD2770 
DTRD27B0 
DTRD2790 
DTRD2800 
DTRD2810 
0TRD2820 
DTRD2830 
DTRD2840 
DTRD2850 
DTRD2860 
DTRD2870 
DTRD2880 
0TRD2S90 
DTR02900 
DTRD2910 
DTRQ2920 
DTRD2930 
DTR02940 
DTRD295D 
DTRD2960 
DTRD2970 
DTRD2980 
DTRD2990 
DTRD3000 
DTRD3010 
0TRD3020 
DTRD3030 
DTPD3040 
DTRD3050 
DTRD3060 
DTRD3070 
DTRD3080 
DTRD3090 



// ASM 



*EMPY/EMPYX — EXTENDED 
*EMPY/EMPYX — EXTENDED 
LIBR 



ENT 
EMPYX STX 
GMPYX EQU 

LD 



EMC 



EMX1 



MX 
MCN 



STO 

A 

STO 

MDX 

NOP 

LD 

A 

S 

STO 

LD 

RTE 

LD 

LIBF 

STD 

BSC 

STO 

SLT 

EOR 

BSC 

EOR 

STD 

LD 

S 

STO 

LDX 

LIBF 

BSC 

DC 

DC 

END 



GMPYX 

EMX1+1 

EMPYX 

*-* 

*+3 

MCN+1 

MX+1 



125 



MCN 

125 

2 

lft 

1 

XMD 

126 

+- 

125 

1 

126 

*+5,+ 

126 

126 

125 

MCN+1 

125 

FARC 



PRECISION FLOAT MULTIPLY 
PRECISION FLOAT MULTIPLY 



SAVE XR1 

LOADER INSERT. 

=1 SET up EXIT. 

OPND ADDRESS INTO XR1. 

COMPUTE PRODUCT EXPONENT. 

= 128 

PICK UP ARG FRACTION. 

MULTIPLY FRACTIONS. 



= 1 

RESTORE XR1. 

EXIT. 


1 



// DUP 

*STORE 



02HS UA GMPYX 



GMPY 





GMPY 


10 


GMPY 


20 


GMPY 


30 


GMPY 


40 


GMPY 


50 


GMPY 


60 


GMPY 


70 


GMPY 


80 


GMPY 


90 


GMPY 


100 


GMPY 


110 


GMPY 


120 


GMPY 


130 


GMPY 


140 


GMPY 


150 


GMPY 


160 


GMPY 


170 


G^PY 


190 


GMPY 


190 


GMPY 


200 


GMPY 


210 


GMPY 


220 


GMPY 


230 


GMPY 


240 


GMPY 


250 


GMPY 


260 


GMPY 


2T0 


GMPY 


280 


GMPY 


290 


GMPY 


300 


GMPY 


310 


GMPY 


320 


GMPY 


330 


GMPY 


340 


GMPY 


350 


GMPY 


360 


GMPY 


370 


GMPY 


380 



CO 



♦EDIV/EDIVX — 1 


EXTENDED 


PRECISION FLOAT DIVIDE 


GDIV 







♦ EDIV/EDIVX— 1 


EXTENDED 


PRECISION FLOAT DIVIDE 


GDIV 


10 




LI BR 








GDIV 


20 




ENT 




GDIVX 




GDIV 


30 




EDIVX STX 


1 


EDX1+1 


SAVE XR1 


GDIV 


40 




GDIVX EQU 




EDIVX 




GDIV 


50 




LO 


L 


*-* 


LOADER INSERT. 


GDIV 


60 




EOC STO 




*+3 




GDIV 


70 




A 




ONE + 1 


=1 SET UP EXIT. 


GDIV 


80 




STO 




EDX1+3 




GDIV 


90 




HOX 


11 


*-* 


OPND ADDRESS INTO XR1. 


GDIV 


100 




NOP 








GDIV 


110 


// DUP 


LD 


1 


2 




GDIV 


120 


♦STORE 


RTE 




16 




GDIV 


130 




LD 


1 


1 




GDIV 


140 




BSC 


L 


DOVL.+- 


CHECK X/O. 


GDIV 


150 




STD 




DVR 




GOIV 


160 




LD 


3 


126 




GDIV 


170 




BSC 


L 


EDX1.+- 


DIVIDEND ZERO TEST. 


GDIV 


180 




EOR 


1 


t 




GDIV 


190 




AND 




EDCN 


=/aooo 


GDIV 


200 




STO 




QSGN 


SIGN OF QUOTIENT. 


GDIV 


210 




BSC 


L 


*+3,+Z 




GDIV 


220 




LDD 


3 


126 


SUBTRACT MAG. OF DIVISOR 


GDIV 


230 




SD 




OVR 


FROM DIVIDEND MAGNITUDE, 


GDIV 


240 




HQX 




*+2 


TO ENSURE DIVIDEND SMALLER 


GDIV 


250 




LDD 


3 


126 


THAN DIVISOR. 


GDIV 


260 




AO 




DVR 




GOIV 


270 




STD 


3 


126 




GDIV 


280 




OR 


3 


127 




GDIV 


290 




BSC 


L 


*+3,Z 




GDIV 


300 




LDD 




DF1 




GDIV 


310 




OR 




QSGN 




GDIV 


320 




MDX 




X 




GDIV 


330 




LDD 




DVR 




GDIV 


340 




LIBF 




XDD 




GDIV 


350 




EOR 




EOCN 


=/8000 


GDIV 


360 




STD 


3 


126 




GDIV 


370 




EOR 




QSGN 




GDIV 


380 




BSC 


L 


*+9,- 




GOIV 


390 




EOR 




QSGN 




GDIV 


400 




BSC 




- 




GDIV 


410 




AD 




ONE 




GDIV 


420 




SRT 




1 




GDIV 


430 




EOR 




EDCN 


=/8000 


GDIV 


440 




X STD 


3 


126 




GDIV 


450 




LO 


3 


125 




GDIV 


460 




A 




ONE+1 




GDIV 


470 




STO 


3 


125 




GDIV 


480 




LD 


3 


125 


COMPUTE QUOTIENT EXPONENT. 


GDIV 


490 




S 


1 







GDIV 


SOO 




A 




EDCN+1 


= 128 


GDIV 


510 




OVL STO 


3 


125 




GDIV 


520 




LIBF 




FARC 




GDIV 


530 




EDX1 LOX 


LI 


*-* 


RESTORE XR1. 


GDIV 


540 







BSC 


L *-* 


EXIT. 


GDIV 550 


DOVL 


LD 


ONE+1 


TURN ON PROGRAM DIVIDE 


GDIV 560 




STO 


3 123 


CHECK INDICATOR. 


GDIV 570 




MDX 


EDX1 




GDIV 580 


QSGN 


DC 







GDIV 590 


ONE 


DEC 


1 




GDIV 600 


DVR 


DEC 





DIVISOR BUFFER. 


GDIV 610 


DF1 


DEC 


1.081 




GDIV 620 


EDCN 


DC 


/8000 





GDIV 630 




DC 


128 


1 


GDIV 640 




END 






GDIV 650 
GDIV 660 


GDIVX 








GDIV 670 



// FOR DUMMY SUBROUTINE FOR 

*ONE WORD INTEGERS 

C DUMMY SUBROUTINE FOR 

SUBROUTINE TRAN 

RETURN 

END 
// DUP 
*STORE WS UA TRAN 



TRANSFORMATIONS 



TRANSFORMATIONS 



TRAN 

TRAN 10 

TRAN 20 

TRAN 30 

TRAN 40 

TRAN 50 

TRAN 60 

TRAN 70 



// FOR SUBROUTINE TO READ AND ADD MATRICES 
*ONE WORD INTEGERS 

C SUBROUTINE TO READ AND ADD MATRICES 
SUBROUTINE MXRAD 

COMMON ICR.ICP, IPR, ITW,ITl,IT2, I PROB , N , NF ,C ASES , NPAGE, I NMD, I PRED , 
II STEP, ICNST, IREAR.KXI 1) , MX< 201 ,NCD1 ,NCD2, NCD3 , I SEQ ,NCAS E, NX ( 1C ! , 
2 EFOUT,EFIN,T0L,FLVBI2) , KNN 
COMMON TITLE! 1 8 ) , VNAME ! 30 ) , SUMY ( 30 ) , SD( 30 > , X I 30 I ,R(30,30) 
101 FORMAT! I4,3I2,5E14.7) 
IKT=0 
9 READ( ICR, 101) I P, MI D, I C , IR, ( X < I I , 1 = 1 , 5 > 
IF! IKT)51,52,51 

51 DO 53 1=1,5 
53 XII >=-X(I> 

52 IF( IP) 30,30,10 

10 IFIMID-21) 11,15,20 
C STORE MATRIX 

11 Jl = IC 
J2 = IC+4 

IF (J2-N) I*, 14,13 

13 J2 = N 

14 K = 

MXT = MID 

DO 12 J=J1,J2 

K = K+l 

12 RC 1R,J) = R( IR,J) + X(K> 
GO TO 9 

C STORE NUMBER OF CASES 

15 CASES = CASES + XI 1) 
GO TO 9 

C STORE MEANS AND STANDARD DEVIATIONS 
20 SUMY(IR) = SUMYUR) + XII) 
SDIIRI = SD(IR) + X(2) 
GO TO 9 

30 IF(MXT-l) 31,31,32 

31 NCASE=MXT 

1 IF( ICNST)50,35,50 
50 ICNST=0 
IKT=l 
GO TO 9 

32 IF (MXT-4) 34,34,35 

34 NCASE=-MXT 
GO TO 1 

35 RETURN 
END 

// DUP 

♦STORE WS UA MXRAD 



MXPD 





MXPD 


IC 


MXRD 


20 


MXRD 


30 


MXRD 


40 


MXRD 


50 


MXRD 


60 


MXRD 


70 


MXRD 


BO 


MXRD 


90 


MXRD 


100 


MXRD 


110 


MXRD 


120 


MXRD 


130 


MXRD 


140 


MXRD 


15H 


MXPO 


160 


MXRD 


170 


MXRD 


ISO 


MXRD 


190 


MXPD 


200 


MXRD 


210 


MXRD 


220 


MXRD 


230 


MXRD 


240 


MXRD 


250 


MXRD 


260 


MXRD 


270 


MXRD 


280 


MXRD 


290 


MXRD 


300 


MXRD 


310 


MXRD 


320 


MXRD 


330 


MXRD 


340 


MXRD 


350 


MXRD 


360 


MXRD 


370 


MXRD 


380 


MXRD 


390 


MXRD 


400 


MXRD 


410 


MXRD 


420 


MXRD 


430 


MXRD 


440 


MXRD 


450 


MXRD 


460 






// FOR SUBROUTINE TO COMPUTE CORRELATION COEFFICIENTS 

♦ IOCS (CARD, 11 32 PRINTER, DISK) 

♦NAME COREL 

*ONE WORD INTEGERS 

C SUBROUTINE TO COMPUTE CORRELATION COEFFICIENTS 

COMMON ICR,ICP,IPR, ITW,IT1,IT2, I PROB.N, NF , CASES , NPAGE, I 
1MX(20),NX(15),FLVB(5),KNN 
COMMON TITLE! 18 ) , VNAME! 30 ) ,SUMY< 30) , SD( 30) , DATA ( 30 ) , R ( 3 
COMMON HIGH(30),HL0W(30) 
DEFINE FILE 606 ( 500 ,65 , U, IT1 ) 
DEFINE FILE 5 ( 30, 60 ,U, IT2 ) 
103 FORMAT! 10X , I 8A4, 5X, 3HJ0B, 17, 5X ,4HPAGE , 16 > 
10* FORMAT! // 11X18HSUMMARY STATI STIC S10X12HN0. OF CASES=,I6, 
1ABLE16X3HL0W9X4HHIGH9X7HAVERAGE7X9HSTD. DEV. 6X8HV AR I ANC 

105 FORMAT! 16X , I 2, 2X, A4, 5X , 5E 15. 5 ) 

106 FORMAT! /1X,24HTHE VARIANCE OF VAR I ABLE , 1XA4, 1X7HI S ZERO 

107 F0RMAT!I4,3I2,5E14.7) 

108 FORMAT! 1H > 

C SUM OF SQUARES TAKEN FROM X-PROD MATRIX 
1 ICA=CASES 
ISW = 1 
KON = 22 
K0N1 = 1 
DO 10 1=1, N 
10 SOU) = R(I,I) 

CALL PRNT(1,1,N,N) 
IF(MX(l)-2) 15,91,91 
C COMPUTE RESIDUAL X-PROD MATRIX 
15 DO 20 1=1, N 
00 20 J=I,N 

R(I,J> = R(I,J! - SUMY! II*SUMY(J )/CASES 
20 R(J,I) = R(I,J) 
CALL PRNT(2,0,N,N) 
C COMPUTE COVARIANCE MATRIX 
DO 30 I=1,N 
DO 30 J=I,N 

R(I,J) = R( I,J)/(CASES-1.) 
30 R(J,I ) = R(I,J) 
CALL PRNTi3,0,N,N) 
C OUTPUT MEANS AND STANDARD DEVIATIONS 
ISW = 2 
KON = 23 

NPAGE = NPAGE + 1 
CALL FMATIIPR.ITW) 
IFIIPR) 31,31,32 
31 WRITE!ITW,103)TITLE,IPR0B,NPAGE 
32 WRITE{ITW,104)ICA 
DO 40 1=1, N 

SUMY(I) = SUMYU1/CASES 
SD( I) = SQRT1R! 1,1)1 
40 WRITE! ITW, 1051 I , VNAME ( I ) ,HLOW{ I ) ,HIGH( I 1 , SUMY! I ) , SD( I ) 
C COMPUTE CORRELATION MATRIX 
45 DO 90 1=1, N 

IF(SDU)) 50,50,60 
50 WRITE(ITW,106) VNAME(I) 
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60 DO 90 J = I,N 

IFtSDIJl) 70,70,80 
70 R(I,J) = 0.0 

GO TO 90 
80 R(I,JI = Rl I,J)/(SD(I)*SD(J)I 

90 R( J, I ) = R( I, J) 
CALL PRNT14,0,N,N) 
IFIMXI4) - 2) 95,91,91 

C PUNCH MEANS, STANDARD DEV. AND NO. OF CASES 

91 READtlCR, 108) 
DO 92 1=1, N 

92 WRITE(ICP,107) IPROB ,KON, KON 1 , I , SUMY! I ) , SD( I ) 
KON = 21 

WRITE! I CP, 107) IPR0B,K0N,K0N1,K0N1,CASES 
GO TO ( 15, 95), ISW 
95 IF1KNN) 150,150,151 

150 CALL LINMREGR2) 

151 CALL LINK(FCTRl) 
END 

// DUP 

*STORE WS UA COREL 
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// FOR MATRIX PRINT/PUNCH ROUTINE 

*ONE WORD INTEGERS 

C MATRIX PRINT/PUNCH ROUTINE 

SUBROUTINE PRNTIHID,KODE,NR,NC) 

COMMON ICR.ICP, IPR, ITW, IT1.IT2, I PROB ,N, NF t C ASES ,NPAGE, I NMD, KX( 5 I , 
1MX!20),NXU5),FLVB(5),KNN 

COMMON TITLE ( 18) , VNAME ( 30) , SUMY( 30! ,SD(30) , DATA ( 30 ) , R( 3C, 30 ) 

101 F0RMAT(5XA4,4X8E13.5) 

102 F0RMAT(5XA4,4X8E13.5) 

103 FORMAT! 10X18A4 , 5X3HJ0BI7 , 5X.4HPAGE 16) 

104 FORMAT! 14, 312, 5E14. 7) 

105 FORMAT1/103H READY THE PUNCH WITH BLANK CARDS AND PRESS START ON 
1HE PUNCH AND CONSOLE. TURN CONSOLE SWITCH 15 ON.) 

106 FORMAT! IH ) 

201 FORMAT! ///2X,8HVARI ABLE, 07X, 8« A4 ,9X1 /// ) 

202 FORMAT (3X8HVARIABLE7X8! 14, 8X>//) 

321 FORMAT!/ 46X.2 8HMATRI X OF RAW CROSS-PRODUCTS ) 

322 FORMAT!/ 43X.33HMATRIX OF RESIDUAL CROSS-PRODUCTS ) 

323 FORMAT! /45X28HVAR I ANCE - COVARIANCE MATRIX 1 

324 FORMAT!/ 42X, 34HMATR IX OF CORRELATION COEFFICIENTS ) 

325 FORMAT! /45X32HMATR I X OF CHARACTERISTIC VECTORS/) 

326 FORMAT! /41X36HN0RMALI ZED UNROTATED FACTOR LOADINGS) 
KNME=1 

IF ( MX (MIO)-l 11000,1,100 
11 = 1 
11=8 

IF1NC-II) 10,11,11 
II = NC 
11 NPAGE = NPAGE + 1 
CALL FMATI IPR.ITW) 
IFIIPR) 12,12,13 

WRITE(ITW,103)TITLE,IPR0B,NPAGE 
GO TO (21, 22, 23, 24, 25, 26), MID 
WRITE1ITW,321) 
GO TO 30 
WRITEI ITW.322) 
GO TO 30 

23 WRITEIITW,323) 
GO TO 30 

24 WRITEIITW,324) 
GO TO 30 

25 WRITE(ITW,325) 
GO TO 30 
WRITE(ITW,326) 
IF(MID-5)40,41,40 
IF!MID-6)42,41,42 
KNME=0 

WRITE(ITW,202)IJ,J=I,II) 
GO TO 43 

WRITE<ITW,20l)(VNAMEU),J = I,II) 
DO 35 K=l,NR 
IF(KODE) 34,33,34 
IF(KNME)44,45,44 

44 KNME=VNAHEIK) 

45 WRITE(ITW,101) VNAME(K) , (R( K, J ) , J = I , I I ) 
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GO TO 35 

34 WRITE! ITW, 102) VNAME! K ) , (R ( K , J ) , J = 1 , 1 1 ) 

35 CONTINUE 
IFINC-II) 36,1000,36 

36 I = 1+8 

II = II + 8 
GO TO 9 
C PUNCH ROUTINE 
100 I = 1 
II = 5 

READIICR.106) 
CALL 0ATSW(15,JIG) 
IF(JIG-2)151,3,3 
3 WRITE(ITW,105) 
PAUSE 

151 IFINC-II) 152,153,153 

152 II = NC 

153 DO 154 K = 1,NR 

154 WRITE(ICP,104) [PROB, MID, I , K , ( R ! K, J ) , J= I , I I ) 
IFINC-II) 155,156,155 

155 I = I + 5 
11=11+5 
GO TO 151 

156 IF(MX(MID)-2) 1000,1,1000 
1000 RETURN 

END 
// DUP 
*ST0RE WS UA PRNT 
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// FOR SUBROUTINE TO COMPUTE COEFFICIENTS OF POLYNOMIAL 

* ONE WORD INTEGERS 

C SUBROUTINE TO COMPUTE COEFFICIENTS OF POLYNOMIAL 

SUBROUTINE PCOEF 

COMMON ICR, I CP, IPR, ITW,ITl,I T 2,IPROB,N,NF,CASES,NPAGE,INMD, ISCRi 
1NCASE,IC0F,IDER,NDER,IALP,INMD2,KX(5),EPS,FLVB(4) ,X9,X14 

COMMON TITLE!18),ID!150),X(150),Y(150),C!51) , ALPHA! 51 ) , BETA (51 ) 

COMMON A!51),TEMP1(51),TEMP2!51),TEMP3(51) 

101 FORMAT! 10X1SA4, 5X3HJOBI 7 , 5X, 4HPAGE , 16) 

102 FORMAT!20XI5,E20.7) 

103 FORMAT!//20X,33HCOEFFICIENTS OF FITTED POLYNOMIAL/ 1 1 ) 
C PROGRAM INITIALIZATION 

B = 0.0 

KKD = NF+1 

DO 1 NN = l.KKD 

AINN1 = CtNN) 

TEMPKNN) = 0.0 

TEMP2INN) = CO 
1 TEMP3INN) = 0.0 
C BEGIN COMPUTATION 

00 6 11=2, KKD 

TEMP2IIII = 1.0 

00 3 NN=2,II 

TEMP3INN) = TEMP2(NN-11-TEMP2(NN)*ALPHA( II-l )-B*TEMPl(N)N) 
C COMPUTATION OF A COEFFIEICENT 

3 A(NN-l) =A(NN-1)+C!II)*TEMP3(NN) 
IF(II-KKD) 4,8,8 

C RESETTING THE VECTORS FOR THE NEXT COEFFICIENT 

4 DO 5 NN=1,II 
TEMPKNN) = TEMP2INN) 

5 TEMP2(NN) = TEMP3INN) 

6 B = BETA! 1 1— 1 ) 

C OUTPUT POLYNOMIAL COEFFICIENTS 

8 NPAGE = NPAGE + 1 
CALL FMAT(IPR,ITW) 
IF(IPR) 81,81,82 

31 WRITE! ITW, 101) T I TLE, IPROB, NPAGE 
82 WRITE! ITW, 103) 
DO 9 J = 1,KKD 
L = J-l 

9 WRITEIITW, 102) L,A( J) 
20 RETURN 

END 
// DUP 
*STORE WS UA PCOEF 
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// FOR SUBROUTINE TO INPUT DATA FOR ORTHOGONAL POLYNOMIALS 

* ONE WORD INTEGERS 

*IOCS(CARD, 1132PR INTER, DISK) 

*NAME POLY 

C SUBROUTINE TO INPUT DATA FOR ORTHOGONAL POLYNOMIALS 

COMMON ICR.ICP, IPR, ITW, IT1, IT2, I PROB , N, N^ ,C 4SES , NPAGE, I 
1NCASE,IC0F,IDER,NDER,IALP, INMD2,KX(5) ,EPS,FLVB ( 4) , XB,X1 

COMMON TITLE! 18), ID! 150) ,X( 150) ,YI 150 ),C( 51) .ALPHA! 51), 

COMMON MFK50) 

DEFINE FILE 606! 150 , 8, U, I Tl ) 

101 F0RMAT(6I2) 

102 FORMAT! 14, 4X,18A4) 

103 FORMAT! 812, F10. 4, 312) 

104 FORMAT! ///43H THE X VALUES HAVE BEEN TRANSFORMED TO X' = 
1*X +■ ( ,E14.7,2H). ) 

105 FORMAT! 10X , 18 A4,5X , 3HJ0B , I 7, 5X, 4HPAGE , I6//1 IX, 28HMA 
IE OF POLYNOMIAL, 5X, 12/1 IX , 10HI NPUT TYPE ,23X , I 2/ 11X ,23HP 
30EFFICIENTS, 10X , I 2/ 11 X , 19HC0MPUTE DER I VAT I VES, 14X, I 2/1 1 
40F DERIVATIVE, 14X , I 2/ I IX , 16HPRED I CTED VALUES , 17X, I2/11X 
50LUTI0N VECTORS, 1 IX , I 2/1 1X20HSEC0NDARY INPUT TYPE,13X,i 
6RIANCE CRITERION, 2X ,F 1 5.9/ 1 IX, 2 1HTRANSF0RMATI0N SWITCH, 

106 FORMATI/11X,THSCALING26X,I2/11X,24HIGNORE POLYNOMIAL OJ 

107 FORMAT! ///,' AN ILLEGAL CHARACTER HAS BEEN ENCOUNTERED 
l',I3,' OF THE ABOVE FORMAT CARD.'/' CHANGE CARD AND RER 

108 FORMAT! ///■ AN ILLEGAL CHARACTER HAS BEEN ENCOUNTERED A 
1TELY COLUMN', 13* OF THE ABOVE DATA CARD.'/" CHANGE OR R 
2AND PRESS START TO CONTINUE') 

109 FORMAT! 3X12, 3E14. 7! 
110 FORMAT!//' INVALID INPUT OPTION-JOB TERMINATED ') 

111 F0RMAT!2E14.7, 12) 

112 F0RMATI//27H X = X' I NO TRANSFORMATION!) 
C SUBROUTINE TO READ AND PRINT PARAMETER CARDS (POLYNOMIA 

KWS=1 

NPAGE = 

READ (2, 101) ICR,ICP,IPR,ITW, IT1, IT2 

IF! IPR)701,702,701 

702 ITW=3 
GO TO 703 

701 ITW=1 

703 READ! ICR, 102) IPROB, TITLE 
READ! ICR, 103) N, I NMD, ICOF , I DER , NDER, I SCR , I ALP , I NMD2 , EPS 

1,KX(4),KX!5) 

CALL FMATI IPR, ITW) 

WRITEIITW, 10 5) T I TLE, I PROB, NPAGE, N, I NMD, ICOF, IDER.NDER, 
1INMD2,EPS,KX(3) 

WRITE! ITW,106)KXI4),KX(5) 

IF! INMD - 2) 1,5,1001 

1001 IF! INMD-31 1002, 1, 1002 

1002 WRITE! ITW, 110) 
CALL EXIT 

1 CALL FMTRD(MF1,IRR) 
CALL PRNTB 
IFfIRR) 2,5 ,2 

2 WRITEIITW, 107) IRR 
CALL EXIT 
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5 NF = N 

10 IFUNMD-2) 11,11,30 

11 DO 14 1=1,150 
IF(INMD-l) 16,16,20 

READ DATA FROM CARD READER 

16 CALL DATRDIMF1,IRR,ID( [),1,IDR,1, 
WRITEI606'I)IDI I),IDR, X(I),YII) 
IFURR) 17,18,17 

17 CALL PRNTB 
WRITEIITW.108) IRR 
PAUSE 10 

GO TO 16 

READI606 , IHD(I),ID«, X!I),Y(I) 
IFC ID(I )1 15,15,19 
lF(IDR) 13,13,12 
ID(I) = -IDII ) 
.IF<KX<3I> 143, 14,143 
CALL TRAN 
CONTINUE 
NCASE = 1-1 
IF!KXI4>>35,200,35 
WRITE![TW,112) 
GO TO 100 

IF(KWS) 356,355,356 
XN=1.0E-30 
X1 = 1.0E<-30 
DO 39 1=1, NCASE 
IF(X( I!-XN)37,37,36 
XN=XII) 

IF(X(II-X1)38,39,39 
X1=X(I) 
CONTINUE 
XB=XN-X1 
X14=4./XB 

XB=-IX1+XH-XN*XN)/XB 
DO 40 1=1, NCASE 
X( I ) = X14*X( I )+XB 
WRITEIITW, 1041X14, XB 
GO TO 100 

READ ALPHA, BETA, C FROM CARD READER 
NP1 = NE1 
KHS=0 

READIICR, 111)X14,XB,KX<4) 
DO 31 1 = 1, NP1 

READIICR, 1091 K,T1,T2,T3 
ALPHA(K) = Tl 
8ETAIK) = T2 
C(K) = T3 
INMD = INMD2 
GO TO 11 
CALL LINKIP0L2) 
END 
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*ONE WORD INTEGERS 

* IOCS! CARD, 1132PRINTER, DISK) 

♦NAME P0L2 

C SECONDARY MAIN FOR ORTHOGONAL POLYNOMIALS 

COMMON ICR, ICP,IPR,ITW,IT1,IT2,IPR08,N,NF, CASES, NPAGE, INMD, I SCR, 
1NCASE,IC0F,I0ER,NDER,IALP,INMD2,KX15),EPS,FLVBI4),XB,X14 

COMMON TI TL6 1 18 >, IDC 150), XI 150), Y( 150 I, CI 511, ALPHA! 51), BETA I 51) 

COMMON YA!150),POLY!150),POLYO(150),POLI150,4),SSRI51) 

DEFINE FILE 606! 1 50, 8, U, IT1 I 
100 FORMATI/2X13HJOB COMPLETED) 

IFUNMD2) 5,5,6 

5 CALL POLSQ 

6 IFIICOF) 8,8,7 

7 CALL PCOEF 

8 IFIIDER) 10,10,9 

9 CALL PDER 

10 IFIISCR) 13,13,11 

11 CALL PFIT 

13 MRITEIITW.100) 
CALL EXIT 

END 

// DUP 

*STORE WS UA P0L2 



P0L2 


10 


P0L2 


20 


P0L2 


30 


P0L2 


40 


P0L2 


50 


P0L2 


60 


P0L2 


70 


P0L2 


80 | 


P0L2 


90 


PCL2 


IOC 


P0L2 


110 


P0L2 


120 


P0L2 


130 


P0L2 


140 


P0L2 


150 


P0L2 


160 


P0L2 


170 


PCL2 


180 


P0L2 


190 


PCL2 


200 


P0L2 


210 


PCL2 


220 


PCL2 


230 






// FOR COMPUTATION OF ORTHOGONAL POLYNOMIALS 
* ONE WORD INTEGERS 

C COMPUTATION OF ORTHOGONAL POLYNOMIALS 
SUBROUTINE POLSQ 

COMMON ICR,ICP,IPR,ITW,ITl,IT2,IPROB,N,NF, CASES, NPAGE, INMD FSra 
1NCASE,IC0F,I0ER,NDER,IALP,INM0 Z ,KX(5),Ips FLVB(4),XB?X 4 ' 
COMMON TITLE( 18), 10(150), X( 150), YU50 ,C( 51J ,ALPHA(5i I BETAI51 1 
COMMON VA(150),POLY(150),POLYO(150),POL, 5oUV,SSR ll 
01 l F N°NOT T S iTisR ED AX f GR£E ° F P0LYN0MI ^ ^ACHED.'^ArIanCE CRITER 

10 \x?H R :iix 2 H^^xLTY* H ???r3nf;r iALs/ixi4HiD£NTiFicATioN7x2Hx 

IS* F F ORMA A TUH } 0X18 ^' 5 »HJOB.7, 5 X,4HPAGE,I6, 

105 FORMAT! /103H READY THE PUNCH WITH BLANK CARDS AND PRESS START ON 
1HE PUNCH ANO CONSOLE. TURN CONSOLE SWITCH 15 ON I 

106 F0RMAT(1XI3,I7,2X4E13.5,4F13.6) 

107 FORMAT! 60X5HALPHA4E13.5) 

108 FORMAT! 61X4HBETA4E13.S) 

109 FORMAT! 64X1HC4E13. 5) 

110 FORMAT!I4,3I2,3E14.7) 

111 F0RMAT(2E14.7,I2) 

112 F0RMAT!1XI3,I7,2X8E13.5) 

114 FORMAT(3X6HDEGREE,I3,10H COMPONENT , I 1 1, 7X,2E14. 5 ) 

C l15 INinI L I X A?i H 0N SI0UALS,0EGREE ' I3 ' 7H <^R., .14,7X^14.5,, 
MN=41 
11 = 1 
Nl = l 
IT = 1 
ISW = 1 
RO = NCASE 
FN = RO 
SY=0.0 
DELI = 0.0 
DO 10 I =1, NCASE 
DELI = DEL1SYII )*Y(I) 
SY=SY+Y!I ) 
POLYO(I) - 0.0 
YAH) = 0.0 

10 POLYII) = 1.0 
YBAR=SY/RO 
SY=DEL1-SY*YBAR 
B=C. 

BEGIN COMPUTATION 

11 S = 0. 
SSR!II)=0.0 
SSRIII+1)=0.0 
DO 12 1=1, NCASE 
S = S£YII)*POLYII) 

COMPUTATION R OF A COEFFICIENT IN THE POLYNOMIAL EQUATION. 

COMPUTE PREDICTED VALUES 
DO 13 1=1, NCASE 

13 YAH) = YA(I)£CIII)*POLYIH 

DETERMINE [F VARIANCE CRITERION IS SATISFIED 
DEL2 = DEL1-S*S/R0 
VAR2 = DEL2/IFN-II-1.0) 
IF|II-NCASE*l)6l0,610,6U 
610 IFIII-1) 17,17,14 

14 IF1ABSIVAR2-VAR1J-EPS) 15,16,16 
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PLSQ 
PLSQ 
PLSQ 
PLSQ 
PLSQ 
PLSQ 
PLSQ 
PLSQ 
IOPLSQ 
PLSQ 
■9PLSQ 100 
PLSQ 110 
PLSQ 120 
PLSQ 130 
TPLSQ 140 
PLSQ 150 
PLSQ 160 
PLSQ 170 
PLSQ 180 
PLSQ 190 
PLSQ 200 
PLSQ 210 
PLSQ 220 
.FPLSQ 221 
PLSQ 222 
PLSQ 223 
PLSQ 224 
PLSQ 230 
PLSQ 240 
PLSQ 250 
PLSQ 251 | 
PLSQ 260 
PLSQ 270 
PLSQ 280 
PLSQ 290 
PLSQ 291 | 
PLSQ 300 
PLSQ 310 
PLSQ 320 
PLSQ 321 I 
PLSQ 330 
PLSQ 340 
PLSQ 350 
PLSQ 351 I 
PLSQ 352 
PLSQ 360 
PLSQ 370 
PLSQ 380 
PLSQ 381 
PLSQ 382 
PLSQ 390 
PLSQ 400 
PLSQ 410 
PLSQ 420 
PLSQ 430 
PLSQ 440 
PLSQ 450 
PLSQ 460 
PLSQ 470 
PLSQ 480 
PLSQ 490 
PLSQ 500 
PLSQ 510 
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19 



191 



20 



21 
45 



5 06 



503 
47 

461 

478 
502 

529 

528 
52 



507 



15 11=11-1 
NF=II-1 
IT=IT-1 
ISW=2 
GO TO 45 
IF(II-N) 17,17,61 

SuSxQ U I A J!° N ° F AL " HA F ° R ™ E P0L ™°"IAL EQUATION 

DO 18 1=1, NCASE 

SUMXQ = SUMXQ £ X! I )*POLYI I )*POLY ( I I 

ALPHA! II) = SUMXQ/RO 

COMPUTATION OF A NEW POLYNOMIAL 
DO 19 1=1, NCASE 
POL!I,IT) = POLY(I) 

po LYo{J, = = ( poL!7 A m AUni * PaLV<I) - B * POLYO(n 

DO 191 1 = 1, NCASE 

SSR!II)=SSR!II)t!!Y!I)-YBAR)*POLY!I)) 

SSR(II+1)=SSR!IH-1)+P0LYIII**2 

SSRIII)=SSR(II)**2/SSRIim) 
COMPUTATION OF BETA FOR THE POLYNOMIAL EQUATION 
K - 0» 
DO 20 1=1, NCASE 
R = R £ POLY! I)*POLY(I) 
BETA! II) = R/RO 
RO = R 
8 = BETA! II) 
GO TO I 21 ,45 I, ISW 

OUTPUT SECTION OF ORTHOGONAL POLYNOMIALS 
IF1IT-4) 60,45,45 
IX = II-l 

IF1KX!5))507,506,507 

IL = II-IT 

NPAGE = NPAGE £ 1 

DO 52 1=1, NCASE 

IF! I-MN 1503,48, 503 

NPAGE =NPAGE*1 

MN=MN+40 

GO TO 47 

IF!I-1)502,47,502 

CALL FMATIIPR.ITW) 

IF(IPR) 461,461,478 

WRITE!ITW,103) TITLE, IPROB, NPAGE 

WRITE(ITW,102)!J,J=IL,IX) 

DIF = YII ) - YAH) 

IF(KXI4I)528,529,528 

Go'to"^' 112 ' I ' ,0ln ' X «»'»»'««".DIF,IPOLII,J|,j-i.ITl 

C R NTINUE H ' 106J I,ID,II ' Xll, ' r «"'««I'.OIF,(POHI,Jl t J.l.ITJ 

IL = ILfil 

WRITE! I TW, 107) (ALPHAII),I=IL,II) 

WRITE!ITW,108) !BETA(I),I=IL,II) 

WRITEIITW.109I ICII),I=IL,II) 

IT = 

GO TO 160,100), ISW 

CONTINUE THE NEXT ORDER POLYNOMIAL 

DELI = DEL2 

VAR1 = VAR2 

II = II £ 1 

IT = IT 5 1 

GO TO 11 



PLSQ 520 
PLSQ 530 
PLSQ 540 
PLSQ 550 
PLSQ 560 
PLSQ 570 
PLSQ 580 
PLSQ 590 
PLSQ 600 
PLSQ 610 
PLSQ 620 
PLSQ 630 
PLSQ 640 
PLSQ 650 
PLSQ 660 
PLSQ 670 
PLSQ 671 
PLSQ 672 
PLSQ 673 
PLSQ 674 
PLSQ 680 
PLSQ 690 
PLSQ 700 
PLSQ 710 
PLSQ 720 
PLSQ 730 
PLSQ 740 
PLSQ 750 
PLSQ 760 
PLSQ 770 
PLSQ 780 
PLSQ 790 
PLSQ 800 
PLSQ 810 
PLSQ 820 
PLSQ 830 
PLSQ 840 
PLSQ 850 
PLSQ 860 
PLSQ 870 
PLSQ 880 
PLSQ 890 
PLSQ 900 
PLSQ 910 
PLSQ 920 
PLSQ 930 
PLSQ 940 
PLSQ 95C 
PLSQ 960 
PLSQ 970 
PLSQ 980 
PLSQ 990 
PLSQ1000 
PLSQ1010 
PLSQ1020 
PLSQ103G 
PLSQ1040 
PLSQ1050 
PLSQ1060 
PLSQ1070 
PLSQ1080 
PLSQ1090 
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61 WRITEIITW.IOI) 

NF = N 
65 !SW = 2 
GO TO 17 
611 WRITEIITW.IOI) 
NF=NCASE-1 
GO TO 65 
C TEST FOR PUNCHING OF ALPHA, BETA, C 
100 IF(IALP) 140,140,125 

125 NFP1 = NFS1 
KON = 24 
K0N1 = 1 
READIICR.104) 
CALL DATSWI15.JIG) 
IF(JIG-2) 151,3,3 

3 WRITEIITW.105) 
PAUSE 
151 WRITEIICP, 1111X14, XB.KX14) 
DO 126 I=1,NFP1 

126 WRITEIICP, 110! IPROB , K0N.K0N1 , I , ALPHA( I ) , BETA! I ) , C( I ) 
IAO HRITEIITW,113) 

00 192 1 = 1, NF 

WRITE!ITW,114)I,N1,SSRII),SSRI1) 

N0F=NCASE-1-I 

ADF^NDF 

SY=SY-SSR(I) 

AMY=SY/ADF 
192 WRITEIITW, 115)1, NOF.SY, AMY 

RETURN 

END 
// OUP 

*STORE US UA POLSQ 

// FOR SUBROUTINE TO COMPUTE POLYNOMIAL PREDICTED VALUES 
* ONE WORD INTEGERS 

C SUBROUTINE TO COMPUTE POLYNOMIAL PREDICTED VALUES 

SUBROUTINE PFIT 

COMMON ICR,ICP,IPR,ITW, IT 1, IT2, IPROB, N.NF , CASES, NPAGE, INMD, ISCR , 
1NCASE,IC0F,IDER,NDER,IALP,INMD2,KX!5),EPS,FLVB(4),XB,X14 

COMMON TITLE! 18 ),IDI150'), XI 150) ,Y 1150), C( 51), ALPHA! 51), BETA<51) 

COMMON YA (150), POLY ( 150), POLYO! 150) 

101 FORMAT! 10X18A4,5X3HJ0BI7, 5X.4HPAGE 16/) 

102 FORMAT! 10X13, 17, 2X4E13. 5) 

103 FORMAT! //8X, 14HIDENT IF ICAT ION, 9X2HX- 12X1HY12X2HY*9X4HY-Y*/V ) 
C INITIALIZATION 

KAJP1 = NFtl 

B=0.0 

DO 1 I=1,NCASE 

YA1I)=0.0 

P0LY!I)=1.0 
1 POLYO!I)=0.0 

DO 6 II =1,KAJP1 
C COMPUTE PREDICTED VALUES 

DO 3 I=1,NCASE 
3 YA(I)=YA( I)£CIII)*POLY<I) 

IF! II-KAJP1)4,8,8 



PLSQ1100 
PLSQ1110 
PLSQ1120 
PLSQ1130 
PLSQ1140 
PLSQ1150 
PLSQ1160 
PLSQ1170 
PLSQ1180 
PLSQ1190 
PLSQ1200 
PLSQ1210 
PLSQ1220 
PLSQ1230 
PLSQ1240 
PLSQ1250 
PLSQ1260 
PLSQ1270 
PLSQ1280 
PLSQ1290 
PLSQ1291 
"PLSQT292 
PLSQ1293 
PLSQ1294 
PLSQ1295 
PLSQ1296 
PLSQ1297 
PLSQ1298 
PLSQ1300 
PLSQ1310 
PLSQ1320 
PLSQ1330 
PFIT 



PFIT 

PFIT 

PFIT 

PFIT 

PFIT 

PFIT 

PFIT 

PFIT 

PFIT 

PFIT 

PFIT 

PFIT 

PFIT 

PFIT 140 

PFIT 150 

PFIT 160 

PFIT 170 

PFIT 180 

PFIT 190 

PFIT 200 

PFIT 210 

PFIT 220 
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C COMPUTE NEXT ORDER POLYNOMIAL 

4 DO 5 1= UNCASE 
TEMP=POLY(I) 

POLYII)=IX II)-ALPHA(II))*POLY(I)-B*P0LYO(I) 

5 P0LY01I )=TEMP 

6 B=BETA( II ) 

C OUTPUT PREDICTED VALUES 

8 LINES = 50 
IF! IPR)7,9,7 

7 WRITEIITW, 103) 

9 DO 12 I=1,NCASE 
IFILINES-50) 11,10,10 

10 NPAGE = NPAGE £ 1 
LINES = 

CALL FMAT(IPR.ITW) 
IF(IPR) 13,13,11 
13 WRITEIITW.lOl) TITLE, IPROB, NPAGE 
WRITEIITW, 103) 

11 DIF = YII I - YA(I) 
LINES = LINES 6 1 

12 WRITEiITW.102) I , ID! I ) , X! I ) , Y( I ) , YA! I ) , DI F 
RETURN 

END 
// DUP 
♦STORE WS UA PFIT 



PFIT 


230 


PFIT 


240 


PFIT 


250 


PFIT 


260 


PFIT 


270 


PFIT 


280 


PFIT 


290 


PFIT 


300 


PFIT 


310 


PFIT 


320 


PFIT 


330 


PFIT 


340 


PFIT 


350 


PFIT 


360 


PFIT 


370 


PFIT 


380 


PFIT 


390 


PFIT 


400 


PFIT 


410 


PFIT 


420 


PFIT 


430 


PFIT 


440 


PFIT 


450 


PFIT 


460 


PFIT 


470 



PDER 620 
POER 630 
D DER 6*0 
POER 650 



// FOR SUBROUTINE TO COMPUTE POLYNOMIAL DERIVATIVES PDER IF(IPR) 111,111,112 p DE p 550 

* ONE WORD INTEGERS PDFR 10 111 WRI TE ( I TH, 10 1 ) T I TL E , I PROS , NPAGE pn F o = ftr1 

C SUBROUTINE TO COMPUTE POLYNOMIAL DERIVATIVES PDER 20 112 WRI TE 1 1 TW, 104) pn FR Ijr. 

SUBROUTINE PDER PDER 30 LINES = „OER 580 

COMMON ICR, ICP.IPR, ITW, IT 1 , I T2 , IPROB,N, NF, CASES, NPAGE, INMD, ISCR, PDER 40 12 L = l onFR 5°n 

INCASE, ICOF,IDER,NOER,IALP,INMD2,KX(5>, EPS, FL VB( 41 , X8, XI 4 PDER 50 LINES = LINES + 2 P q E p 1 C1 

COMMON TITLEI18),ID(150),X(150),Y<150),C(51),AL°HA(51),BETA<51I PDER 60 WR I TE < I TW, 102 ) ID [ I LI ) , XB , DERI V ( 1 ) ,L ,DER I V! 2 ) onFR^lO 

COMMON DPOLY(51),DERIV(51l,DOPOL(51) POER 70 IFINDP1-3) 25,13,13 ~ " 

101 FORMAT! 10X1 8A4, 5X3HJ0BI 7 , 5X, 4HPAGE, 16 ) POER 80 13 DO 14 J=3,NDP1 

102 FORMAT(/ 5X, I9.7X, 2F1 5. 5 , I 1 2, 7X ,F15. 5) PDER 90 L = J-l 

103 F0RMAT(61XI2,7XF15.5) PDER 100 LINES = LINES + 1 

104 F0RMAT(//5X,14HIDENTIFICATI0N,14X2HX' 14X2HY*8X1 2HDER I V. CRDER7X 12H POER 110 14 WR I TE ( I TW, 103 ) L,DERIV(J) pnFP 660 
1DERIV. VALUE/I PDER 120 25 CONTINUE pnFR tin 

IF(NDER)17,16,17 PDER 130 16 RETURN „„ ?I„ 

17 LINES = 50 PDER 140 END pngp l 90 

IF(NF-NDER)30,31,3l PDER 150 // DUP pn F = ?na 

30 NDPl=NFtl PDER 160 *STORE WS UA PDER PDER 710 
GO TO 32 POER 170 

31 NDP1 = NDER *■ 1 POER 180 

32 KBJP1 = NF + 1 PDER 190 
DO 25 IL1=1,NCASE PDER 200 
IF(IDULl)) 1,25,25 POFR 210 

1 XB = X( IL1) PDER 220 
DO 2 II = 1.K8JP1 POER 230 
DPOLY(II) = 0.0 ' PDER 240 

2 DOPOLI II) = 0.0 PDER 250 
DP0LYIKBJP1 + L) = 0.0 PDER 260 
DPOL =. 1.0 PDER 270 
NN = 1 PDER 280 
GO TO 4 PDER 290 

C BEGIN COMPUTATION. PDER 300 

3 DPOL = DPOLY(NN) PDER 310 

4 DPOLO = 0.0 PDER 320 
DERIV(NN)=0.0 PDER 330 
B = 0.0 POER 340 
11=1 PDER 350 

C COMPUTATION OF FITTED VALUE AND DERIVATIVE. PDER 360 

5 DERIV(NN) = OERIVINN) + C(tl) * DPOL PDER 370 
IFtll-KBJPl) 6,7,7 PDER 380 

C COMPUTATION OF A NEW POLYNOMIAL DERIVATIVE. PDER 390 

6 TEMP = DPOL PDER 400 
DPOL = (XB - ALPHA! II ) )*DPOL «■ ( NN - 1) * DOPOL(II) -B*0POLO PDER 410 
DPOLO = TEMP PDER 420 
D0P0H1 I )=DPOLO POER 430 
B = BETA! II) PDER 440 
11=11+1 PDER 450 
GO TO 5 PDER 460 

C COMPUTATION OF THE NEXT DERIVATIVE. PDER 470 

7 IFINN - NDP1) 8,9,8 PDER 480 

8 NN = NN + 1 PDER 490 
GO TO 3 PDER 500 

C OUTPUT DERIVATIVE PDER 510 

9 IF(LINES-50) 12,11,11 PDER 520 
11 NPAGE=NPAGE + 1 PDER 530 

CALL FMATI IPR.ITW) PDER 540 
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REGR 


80 
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REGR 


90 




REGR 


100 




REGR 


110 




REGR 


120 




REGR 


130 




REGR 


140 





// FOR INPUT DATA SUBROUTINE 

*ONE WORD INTEGERS 

* IOCS! CARD, 11 32 PR INTER, DISK) 

*NAME REGR 

C INPUT DATA SUBROUTINE 

COMMON ICR, ICP.IPR, ITW, IT It IT2, I PROB, N, NF , CASES , NPAGE , I NMD, I PRED, 
1ISTEP.ICNST, IREAR.KXI 1>,MX< 20) ,NCD(3) , I SEO, NCAS E, NX( 10 I , 

2 EF0UT,EFIN,T0L,FLVB(2),KNN 

COMMON TITLE I IB ) , VN AME ( 30) , SUMY ( 30 ) , SD( 30 ) ,X ( 30) ,R ( 30, 30) 

COMMON HIGH I 301 ,H LOW( 30 ) , MF ( 50 , 3 1 

DEFINE FfitE 606(500, 65, U, IT1) 

101 FflRMAT(6I2> 

102 FORMAT! I4,4X,18A4) 

103 F0RMATI15I2, 2F4.3.F6.5) 

104 FORMAT! 20A4) 

105 FORMAT! 10X , 18 A4 ,5X , 3HJ0B, I 7 , 5X .4HPAGE, I 6// I IX , 1 9HNUMBER OF VARREGR 150 
1IABLES,16X,I2/11X,10HINPUT TYPE , 25X , I 2/ 1 IX, 14HSF0UENC E CHECK 21XREGR 160 
2I2/11X.19HVARIABLES ON CARD 1 1 6X , I 2/ 1 1 X19HVAR I ABLES ON CARD 2 16XREGR 170 
312/ 1 1 X . 19HVAP.IABLES ON CARD 3 16 X , ! 2/ 1 1 X ,2 lHTRANSFHRMAT ION SWTTCH.REGR 180 
414X,r2/llX,25HGUTPUT RAW CROSS PRODUCTS 10X , I 2/ 1 IX , 30H0UTPUT RESIDREGR 190 
5UAL CROSS PRODUCTS 5X.I2! REGR 200 

106 FORMAT! 11X.22HPRINT PREDICTED VALUE S , 13X , I 2 / 11 XI 1 HPR [NT STE PS , 24X, REGR 210 
1I2/11X.14HP00LING OPTION, 21X, 12 /HX, 18HDE PENDENT VARIABLE 17REGR 220 
2X,I2/11X,27HF-LEVEL TO REMOVE VARI ABLES , F10 . 3/ 1 IX , 26HF-LEVEL TO ENREGR 230 
3TER VARIABLES, F 1 1 .3/1 1 X , 1 5HT0LERANCE VALUE , I IX , F 1 1 . 5/ 1 1 X, 28HOUTPUTREGR 240 
4 VARIANCE - COVARIANCE 7X , 1 2/ 1 1 X , 18H0UTPUT CORRELATION 17X.I2) REGR 250 

107 FORMAT!///' AN ILLEGAL CHARACTER HAS BEEN ENCOUNTERED IN COLUMN', REGR 260 

113,' OF THE ABOVE FORMAT CARD.'/' CHANGE CARD AND RERUN JOB.') REGR 270 

loS FORMAT! ///' AN ILLEGAL CHARACTER HAS BEEN ENCOUNTERED AT APPROX I MAREGR 280 

1TELY COLUMN', 13,' OF THE ABOVE OATA CARD.'/' CHANGE OR REMOVE CARDREGR 290 

2 AND PRESS START TO CONTINUE.') < REGR 300 

109 FORMAT! //5X4HCARD 1 1 0,4H NO. 14, IX 30HIS OUT OF SEQUENCE. RFRUN JOB. REGR 310 

1 ) REGR 320 

110 FORMAT! //' INVALID INPUT OPTION-JOB TERMINATED ') REGR 330 

KNN = REGR 340 

NPAGE = REGR 350 

REA0(2,101) ICR,IC°,IPR,ITW,IT1, IT2 REGR 360 

IF! IPR)701,702,701 REGR 370 



702 ITW=3 

GO TO 703 
701 ITW=1 

703 READ(ICR,102) IPROB, TITLE 

READ! ICR, 10 3) N , I NMD, I SEQ, < NCD! I ) , I = 1 , 3 ) ,MX!20), 
II MX! I) , 1=1,4-), I PRED, I STEP, I CNST, I REAR, EFCUT , EF IN, 
CALL FMAT( IPR, ITW! 



TOL 



REGR 330 
REGR 390 
REGR 400 
REGR 410 
REGR 420 
REGR 430 
REGR 440 



WRITE (ITW, 10 5) TITLE,IPROB,NPA3E,N,INMD,ISE0, ( NCD ( I ) , I = 1 , 3 ) , MX ( 20) REGR 450 

1 , ( MX ( I ) , I =1 , 2) REGR 460 

WRITE!ITW,I06) IPRED,ISTEP,ICNST,IREAR,EFOUT,EFIN,T0L, REGR 470 

1(MX(I),I=3,4) REGR 480 

READ(ICR,104) IVNAMEI I) ,1=1, N) REGR 490 

IFUNMD-1) 1002,1,1004 REGR 500 

1004 IFUNMO-4) 5,1002,1002 REGR 5 10 

1 DO 4 1=1,3 REGR 520 

CALL FMTRDIMF! 1,1 ),IRR) REGR 530 

CALL drmtb REGR 540 



IF(IRR) 2,3,2 

2 WRITE(ITW,107) IRR 
CALL EXIT 

1002 WRITE(ITW.llO) 
CALL EXIT 

3 IFINCDI 1+1) ! 5,5,4 

4 CONTINUE 
SUBROUTINE TO READ SOURCE DATA 
INITIALIZATION 

5 DO 8 1=1, N 
HIGH! I) = 0. 
SD(I)=0. 

HLOWII) = l.CE+36 
SUMYtl) = 
DO 8 J=1,N 

8 R( I , J) = 0.0 

KOUNT = 

CASES = 0. 

NCASE = n 

9 -IT1- =■ 1 

10 GO TO I 11,41,51), INMD 

CARD READER INPUT 

11 1ST = 1 
1 = 1 

IF(NCDd)) 12,12,13 

12 NCD! 1) = N 

13 CALL DATRD(MF(1,1),IRR,ID,1,NC,1, X, -NCD ( 1 ) , 0, ) 
IF(IRR) 14,15,14 

14 CALL PRNTB 
WRITE! ITW, 108) IRR 
PAUSE 10 

GO TO ( 13,18,18),! 

15 IF(IO) 100,16,16 

16 DO 22 1=2,3 
IF(NCDd)) 23,23,17 

17 1ST = NCD(I-l) + 1ST 

18 CALL DATRDIMF(1,I ) , IRR , I Dl , 1 ,MC 1 , 1 , XI I ST ) , -NCD ( I ) , ,0) 
IF(IRR) 14,19,14 

19 IF! ISEQ) 22,22,20 

20 IF(IO-IDl) 60,21,60 

21 IF(MCl-NC) 60,60,6 

6 ID = ID1 
NC = NCI 

22 CONTINUE 
GO TO 23 

60 WRITE! ITW, 109) ID1,NC1 
CALL EXIT 

23 IF(MX<20)1 230,231,230 

230 CALL TRAN 

231 IF(INMO-l) 1002,27,30 

27 WRITE(606'IT1) ID , (X!I),I=1,N) 
C COMPUTE CROSS PRODUCT MATRIX 
30 CASES = CASES + 1. 
NCASE = NCASE + 1 
DO 35 I = 1,N 



REGR 550 
REGR 560 
REGR 570 
REGR 580 
REGR 590 
REGR 600 
REGR 610 
REGR 620 
REGR 630 
REGR 640 
REGR 650 
REGR 660 
REGR 670 
REGR 680 
RFGR 690 
REGR 700 
REGR 710 
REGR 72 
REGR 730 
REGR 740 
REGR 750 
REGR 760 
REGR 770 
REGR 780 
REGR 790 
REGR 800 
REGR 810 
REGR 820 
REGR 830 
REGR 840 
REGR 850 
REGR 860 
REGR 370 
REGR 880 
REGR 890 
REGR 900 
REGR 910 
REGR 920 
REGR 930 
REGR 940 
REGR 950 
REGR 960 
REGR 970 
REGR 980 
REGR 990 
REGR1000 
REGR1010 
REGR1020 
REGR1030 
REGR1040 
REGR1050 
REGR1060 
REGP1070 
REGR1080 
REGR1090 



SUMY(I) = SUMYI I) + X(I) 

DO 35 J = [,N 

RII.J) = R(I,J) + XfI)*X( J) 

R(JiI) = R( I ,J) 

DETERMINE HIGH AND LOW VALUES 

DO 39 1=1, N 



41 



51 

100 

150 

151 
200 
572 
571 



HIGH(I)) 37,37,36 

X( I) 

HLOW(I) )38, 39,39 

X(I1 



,(X(I),I = 1,N> 



IF(X(I) - 

36 HIGH! I I = 

37 IF(X( I) - 

38 HLOWI 1) = 

39 CONTINUE 
GO TO 10 

READ(606'IT1) ID 
IF(ID) 100,100,23 
READ A MATRIX FROM CARDS 
CALL MXRAD 

IF(INMD-l) 1002,150,151 
WRITE(606'IT1) 10 , ( X( I 1 , 1 = 1, N) 
IT1 = 1 

IF[NCASE)571,571,572 
CALL LINMCOREL) 
CALL LINKiREGR2i 
END 



// DUP 
*STORE 



WS UA REGR 



REGR1100 
REGR1110 
REGR1120 
REGR1130 
REGR1140 
REGR1150 
REGR1160 
REGR1I70 
REGR1180 
REGR1190 
REGR1200 
REGR1210 
REGR1220 
REGR1230 
REGR1240 
REGR1250 
REGR1260 
REGR1270 
REGR1280 
REGR1290 
REGR1300 
REGR1310 
REGR1320 
REGR1330 
REGR1340 



// FOR CALLING PROGRAM FOR CORRELATION AND REGRESSION 
* IOCS (CARD, 11 32 PR INTER, DISK) 
*0NE WORD INTEGERS 
*NAME REGR2 

COMMON ICR.ICP.IPR, ITW,IT1,IT2, IPROB,N,NF, CASES, NPAGE, I NMD, I PRED, 

1ISTEP,ICNST,IREAR,KX(1),MX(20),NCD1,NCD2,NCD3,ISEQ,NCASE,NX(10), 
2 EF0UT,EFIN,T0L,FLVB(2),KNN 

COMMON TITLE(18I,VNAME(30),SUMY(30),SD(30>,X(30I,R<30,30) 
COMMON HIGH! 30), HL0W(30) "" 

DEFINE FILE 6C6( 500 ,65 ,U, IT1 ) 
100 FORMAT! //2X13HJ0B COMPLETED) 
IF(ISTEP>4,4,2 

2 IF( IREAR) 4,4,3 

3 CALL REGRE 

4 WRITE(ITW,100) 
CALL EXIT 

END 



// DUP 

* STORE 



WS UA REGR2 
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// FOR SUBROUTINE FOR STEPWISE REGRESSION RGRE 

*ONE WORD INTEGERS RGRE 

C SUBROUTINE FOR STEPWISE REGRESSION RGRE 

SUBROUTINE REGRE RGRE 

DIMENSION INDEXOOl RGRE 

COMMON ICR, ICP.IPR, I TW,ITl.IT2,IPROB,N,NF, CASES, NPAGE, INMD,IPRED, RGRE 

IISTEP,ICNST,IREAR,KX{1),MX(20),NXI15),EF0UT,EFIN,T0L,FLVB12},KNN RGRE 

COMMON TITLE! 18) , VNAME ( 30) , SUMYI 30) tS0(30) .DATAI30) ,R1 30, 30 > RGRE 

COMMON CORRY(30),COENI 30) R GR£ 

101 FORMATI 10X18A4,5X3HJOBI7, 5X.4HPAGE 16) RGRE 

102 F0RMATI//5X,19HREGRESSI0N ANALYSIS //5X , 18HDEPENDENT VARIABLE .16XRGRE 
1,A4/5X,27HRESI0UAL STANDARD DEVI ATI0NFU.4/5X, 26HSTANDARD ERROR OFRGRE 
2 THE MEAN F 12.4/5X, 10HMULTI PLE R 18X, F10 .4/5X, 13HMULTIPLE RSQR ISXRGRt 
3.F10.4) R G R E 

103 FORMATI ///4X, 16HVARI ABLE REMOVED 18X,A4//) R GRE 

104 FORMATI ///4X, 16HVARIABLE ENTERED 18X,A4//) RGRE 

105 F0RMAT(//3X,8HVARIABLE11X,8HB - COEF 4X,14HSTD ERROR OF B 9X, RGRE 
19HPARTIAL-R,8X,9HBETA-CQEF 4X17HSTD ERROR OF BETA/) RGRE 

106 F0RMATI///30X26HANALYSIS OF VARIANCE TABLE) RGRE 

107 F0RMATf5X,A4.6X.2F15,4,13X,F7,4,2X,F15.4.,3X,F15.4) RGRE 

108 FORMAT!/// 2X .8HC0NSTANT 4X.F15.4) RGRE 

109 FORMAT!/// 33X, 16HPREDICTED VALUE S// 1 IX .4HCASE , 12X.6HACTUAL , 1 IX , RGRE 
19HPRE0ICTED,16X,8HRESI0UAL///J RGRE 

110 FORMATI 10X, 15, 3I5X.E15.4)) RGRE 

111 FORMATI/15X6HSOURCE13X4HD.F.05X14HSUM OF SQUARES3X11HMEAN SQUARE08RGRE 
1X1HF) R GRE 

112 FORMAT!/// 42HMEAN SQUARE NON-POSITIVE- JOB TERMINATED. ) RGRfc 

113 FORMAT I///41H NO MORE DEGREES FREEDOM. JOB TERMINATED. ) RGRE 

114 FORMAT! 1 5X10HREGRESSI 0N5X, 16 ,5X, E 14. 5.E16. 5, E 15 .5 ) RGRE 

115 FORMAT! /// 62HN0 MORE VARIABLES SATISFY VARIANCE CRITERION. JOB TRGRE 
1ERMINATED. ) RGRE 

116 FORMATI 15X5HERR0R10X,I6,5X,E14.5,E16.5) RGRE 

117 FORMAT! /15X4HMEAN11X,I6,5X,E14.5,E16.5I RGRE 
PLACE DEPENDENT VARIABLE AT END OF MATRIX RGRE 
IK 1=1 RG R E 
IKT=0 RGRE 
IFIIREAR) 6,6,2 RGRE 

2 DO 3 I = 1,N RGRE 
T = R!I ,N) R GRE 
Rl I,N) = R(I.IREAR) RGRE 

3 RII.IREAR) = T RGRE 
DO 4 1=1, N RGRE 
T = R1N.I) RGRE 
R!N,I) = R1IREAR.I) RGRE 

4 RIIREAR.I) = T RGRE 
T = SUMY1N) RGRE 
SUMYIN) = SUMYUREAR) RGRE 
SUMY1IREAR) = T RGRE 
T = SDINI RGRE 
SDIN) = SD(IREAR) RGRE 
SOIIREAR) = T RGRE 
T = VNAMEIN) R GRE 
VNAMEIN) = VNAME(IREAR) RCRE 
VNAMEIIREAR) = T RGRE 
INITIALIZE COMPUTATIONAL PARAMETERS RGRE 
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NOVMI = N-l 

DO 7 I = 1, NOVMI 

CORRYlI ) = RII.N) 

DEFR = CASES - 1. 

SSM=CASES*SUMY!N>**2 

SSY=DEFR *SD!N)**2 

ANODA = SQRTf DEFR/CASES ) 

NOENT = 

NOMIN = 

NOMAX = 

START OF MAIN ITERATION FOR A VARIABLE 

COMPUTE STANDARD ERROR OF MEAN AND ESTIMATE 

SMEAN = SD<NI*SQRTIR{N,N)/DEFR)*ANaDA 

SEST = SMEAN * SQRTICASES1 

COMPUTE MULTIPLE R AND MULTIPLE R**2 

R2M1 = l.O-RIN.N) 

IFIR2M1) 31,31,30 

RMLT = SQRTIR2M1) 

GO TO 3 2 

RMLT =0.0 

RSQ"= RMLT**2 "'"' 

INITIALIZE VARIABLE ENTRY PARAMETERS 

VMIN = 1.0E20 

VMAX = 0.0 

VAR = 0.0 

NO IN = 

OETERMINE ENTRY VARIABLES AND COMPUTE COEFFICIENTS 

AND THEIR STANOARD ERRORS 

00 56 1=1, NOVMI 

IFIR! I, I) - TOD 56,42,42 

VAR = R!I,N)*R!N,I)/R!I,I) 

IF1VAR) 44,56,53 

NOIN = NOIN 6 1 

INDEXINOIN) = I 

IF IABS1VAR) - ABSIVHIN)) 50, 50, 56 

VMIN = VAR 

NOMIN = I 

GO TO 56 

IFIVAR-VMAX) 56,56,54 

VMAX = VAR 

NOMAX = I 

CONTINUE 

IF NO VARIABLES ENTERED GO TO NEXT ITERATION 

IFINOIN) 82,82,66 

OUTPUT REGRESSION EQUATION FOR THIS STEP 

IFIISTEP)400,401,400 

IF! ISTEP-NOIN) 68,68,78 

NPAGE = NPAGE 6 1 

CALL FMAT1IPR, ITH) 

IFIIPR) 681,681,682 

WRITEIITwaOl) TITLE, IPROB, NPAGE 

WRITE !ITW,102) VNAMEIN), SEST, SMEAN, RMLT, RSQ 

IF(NOENT) 69,69,71 

WRITEIITW,103) VNAMEIK) 

GO TO 72 



RGRE 550 
RGRE 560 
RGRE 570 
RGRE 580 
RGRE 590 
RGRE 600 
RGRE 610 
RGRE 620 
RGRE 630 
RGRE 640 
RGRE 650 
RGRE 660 
RGRE 670 
RGRE 680 
RGRE 690 
RGRE 700 
RGRE 710 
RGRE 720 
RGRE 730 
RGRE 740 
RGRE 750 
RGRE 760 
RGRE 770 
RGRE 780 
RGRE 790 
RGRE 800 
RGRE 810 
RGRE 820 
RGRE 830 
RGRE 840 
RGRE 850 
RGRE 860 
RGRE 870 
RGRE 880 
RGRE 890 
RGRE 900 
RGRE 910 
RGRE 920 
RGRE 930 
RGRE 940 
RGRE 950 
RGRE 960 
RGRE 970 
RGRE 980 
RGRE 990 
RGRE1000 
RGRE1010 
RGRE1020 
RGRE1030 
RGRE1040 
RGRE1050 
RGRE1060 
RGRE1070 
RGRE1080 
RGRE 1090 



o 

Ol 



71 WRITE(ITW,104) VNAME(K) 

72 WRITE(ITW,105) 
63 CNST = SUHY(N) 
65 00 76 I=1,N0IN 

IL = INOEX( [) 

PARTL = 0.0 

COMPUTE COEFFICIENTS AND THEIR STANDARD ERRORS 

BETA = R( IL,N] 

COEN(I) = BETA*SD(NI/SD(ILI 

BER = SQRT(R(N,N)*R(IL,IL)/DEFR) 

SIGM = BER*SD(N)/SO< IL) 

COMPUTE PARTIAL CORRELATION COEFFICIENTS 

DO 58 J = l.NOIN 

JL = INDEXIJ) 
58 PARTL=PARTL+(R!JL,N)-R(IL,N> *R( JL , IL) /Rf IL , IL) )*CORRYIJL ) 

PARTL = SIGN(SORT(1.0-R(N,N)/(1.0-PARTL )l,COEN(I)) 

WRITE! I TW, 107) VNAME(IL),COEN( I), SIGM, PARTL, BETA, BER 

COMPUTE CONSTANT TERM 
76 CNST = CNST-(COEN(I)*SUMY(ID) 

WRITEIITW,108) CNST 

WRITEUTW.106) 

WRITEf ITWtlll) 

IDF=CASES-DEFR-1. 

IEDF=DEFR 

AMSE=SEST**2 

SSE=AMSE*OEER 

SSR=SSY-SSE 

AMSR=SSR/ICASES-DEFR-l.) 

AF=AMSR/AMSE 

WRITE! ITW,H7)IK1,SSM,SSM 

WRITE(ITW,U4)IDF,SSR,AMSR,AF 

WRITE(ITW,116)IEDF f SSE,AMSE 

PRINT PREDICTED VALUES AND RESIDUALS 
78 IF(INMD-3)178, 79,178 
178 IFIIPREDI79 ,79,251 
251 IF(IPRED-ISTEP)79,151,151 
151 IF(NOIN-IPRED) 79,77,77 
77 LIZ = 40 

IT1 = 1 

16 REA0(606'IT1) ID , ( DATA (II , I =1 ,N ) 
IF (ID) 79,79,17 

17 IF(IREAR) 19,19,18 

18 T = DATA(N) 

DATA(N) = DATA(IREAR) 
DATA(IREAR) = T 

19 YPRED = CNST 

DO 22 I=1,N0IN 

KK = INDEX! I) 
22 YPRED = YPRED £ COENI I ) * OATA(KK) 

OEV = DATA(N) - YPRED 

IFILIZ-40) 25,24,24 
24 LIZ = 

NPAGE = NPAGE £ 1 

CALL FMATIIPR.ITW) 

IF(IPR) 241,241,242 
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// DUP 



REMOVE VARIABLE K 



HRITEIITW.lOl) TITLE, IPROB, NPAGE 

WRITE(ITW,109) 

LIZ = LIZ 6 1 

WRITEIITW.llO) ID,DATA(N),YPRED,DEV 

GO TO 16 

IF VARIANCE CONTRIBUTION INSIGNIFICANT 

IF( IKT) 179,179,401 

FLEV = ABSIVMIN) * DEFR / R(N,N) 

IF (FLEV - EFOUT) 80,82,82 

K = NOMIN 

DEFR = OEFR S1.0 

NOENT = 

GO TO 89 

IF VARIANCE CONTRIBUTION SIGNIFICANT - ENTER VARIABLE K 

OENOM = R(N,N) - VMAX 

IF(DENOM) 210,210,84 

FLEV = VMAX * DEFR / OENOM 

IF (FLEV - EFIN) 402,402,87 

K = NOMAX 

NOENT = K 

DEFR=DEFR-1,0 

IF DEGREES OF FREEDOM NON-POS ITI VE, TERMINATE JOB 

IF(DEFR) 34,89,89 

WRITEIITW,113) 

RETURN 

IF VARIANCE CRITERION NOT SATISFIED - TERMINATE JOB 

IF(K) 90,90,92 

WRITE(ITW,115) 

GO TO 401 

REARRANGE INVERSE FOR ENTERING OR DELETING A VARIABLE 

DO 98 1=1, N 

IF(I-K) 94,98,94 
DO 97 J=1,N 

IF(J-K) 96,97,96 

R(I,J) = R(I,J) - (R(I,K)*R(K,J)/R(K,K)) 

CONTINUE 

CONTINUE 

DO 202 1=1, N 

IF(I-K) 201,202,201 

IUI,K) = -R(I ,K)/R(K,K) 

CONTINUE 

DO 206 J=1,N 

IF(J-K) 205,206,205 

R(K,J) = R(K,J)/R(K,K) 

CONTINUE 

R(K,K1 = 1.0/RIK.K) 

TEST FOR POSITIVE MEAN SQUARE 

IF(R(N,N)) 210,210,11 

WRITE(ITW,112) 

GO TO 401 

IKT = 1 

IF( INMD-31404,401,404 

IF(IPRED) 77,401,401 

END 
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♦STORE 



WS UA REGRE 



RGRE2200 // FOR SUBROUTINE TO READ PARAMETER CARDS 
*ONE HORO INTEGERS 
* IOCS ICARD.1132PRINTER, DISK) 
*NAME ANOVA 
C 






AND DATA NOVA 

NOVA 

NOVA 

NOVA 

SUBROUTINE TO READ PARAMETER CARDS AND DATA NOVA 

COMMON ICRtlCP.IPR. I TW, I T 1 , IT2 , 1 PROB, NPAGE , I NMD, NF, ITRN ,NA, NB, NC , NOVA 

1ND,TITLE(18),NX(5),LS!51,INI4),NDIV<20),SMQR120),XDEV(2 0>,X!1500> NOVA 

DEFINE FILE 6061 500 ,6 ,U , IT1 ) NOVA 

DEFINE FILE 607( 1000, 2, U, IT2) NOVA 

101 FORMAT (712) NDVA 

102 FORMAT ( 10X, 1 8A4, 5X, 3HJ08, I 7 , 5X.4HPAGE , 16/// 10X , 17HNUMBER OF FNOVA 
1ACT0RS,15X,I2/ 10X.10HINPUT MODE ,22X, I 2/ 10X, 2 1HTR ANSFORMAT ION SWINOVA 
2TCH,11X,I2/ 10X,27HNUMBER OF LEVELS - FACTOR 1,5X,I2/ 10X , 27HNUMBEN0VA 
3R OF LEVELS - FACTOR 2,5X,I2/ 10X , 27HNUMBER OF LEVELS - FACTOR 3, NOVA 
45X.I2/ 10X.27HNUMBER OF LEVELS - FACTOR 4.5X.I2) NOVA 

103 F0RMAT(6I2) N0VA 

104 F0RMAT(I4,4X,18A4) NOVA 
L07 FORMAT! ///• AN ILLEGAL CHARACTER HAS BEEN ENCOUNTERED IN COLUMN 1 , NOVA 

113," OF THE ABOVE FORMAT CARD. 1 /' CHANGE CARD AND RERUN JOB.*) NOVA 

FORMAT! ///■ AN ILLEGAL CHARACTER HAS BEEN ENCOUNTERED AT APPROX I HANOVA 

1TELY COLUMN', 13, • OF THE ABOVE DATA CARD.'/' CHANGE OR REMOVE CARDNOVA 



108 



2 AND PRESS START TO CONTINUE.') 
109 FORMAT!// 1 INVALID INPUT OPTION-JOB TERMINATED ') 
READ PARAMETER CARDS 
NPAGE=0 

READ! 2, 10 3) IC R, ICP ,1 PR , I TW, IT1 , IT2 
IF! IPR)701,702,701 

702 ITW=3 

GO TO 703 
701 ITW=1 

703 READ(ICR,104) IPROB, TITLE 

READ (ICR.lCl) NF,INMD,ITRN,(NX( I), 1=1,4) 

CALL FMAT! IPR.ITW) 

WRITE !ITW,102) T ITLE , I PROB, NPAGE , NF , INMD, I TRN, ( NX! I ) , I =1 , 4) 

IF(INMD-l) 1,1,3 

1 CALL FMTRD!NDIV,IRR) 
CALL PRNT8 

IF(IRR) 2,5,2 

2 WRITEIITW,107) IRR 
CALL EXIT 

SUBROUTINE TO READ SOURCE DATA (ANALYSIS OF VARIANCE) 



3 


IF! INMD-2)5,5,4 


4 


WRITE(ITW,109) 




CALL EXIT 


5 


NA = NX(1) + 1 




NB = NXI2) + 1 




NC = NX(3) + 1 




ND = NX (4) + 1 




LS(1) = 1 




LS!2) = NA 




LS(3) = LS(2) * NB 




LSI4) = LS(3) * NC 




LS!5I=LS!4)*ND 




J-l 


89 


GO TO (10, 40), INMD 
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// OUP 
*STORE 



READ DATA FROM CARD READER 

CALL DA TRD( NOIV, I RR,IN( 11,4, DATA, -1,0,0) 

WRITE(606'J) { INU >, 1=1,4! , DATA 

J = J+1 

IF(IRR) 17,18,17 

CALL PRNTB 

*miTEUTW,108) IRR 

PAUSE 10 

GO TO 10 

IF( ITRN) 19,20,19 

CALL TRAN 

IF ( IN(ll) 50,50,21 

IS=IN( 1) 

DO 30 1=2, NF 

IS=IS<-LS(D*(INII)-1) 

CALL STORE (DATA, IS) 

GO TO 189 

READ DATA FROM DISC OR TAPE 

READC606'J) ( IN ! I 1 , 1 = 1, 4) ,OATA 

J = J + 1 

GO TO 18 

CALL LINMANQV2) 

END 

WS UA ANOVA 
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// FOR SUBROUTINE TO STORE A DATUMIN CORE OR DISC 
*0N£ WORD INTEGERS 



STOR 
STOR 
STOR 
STOR 



SUBROUTINE TO STORE A DATUMIN CORE OR DISC 

SUBROUTINE STORE (DATA, IS) „„,, 

COMMON ICR,IRP,IPR, ITW, IT 1 , I T2 , I PROB, NPAGE, INMD.NF, ITRN ,NA, NB.NC , STOR 

Tnw 5 ™!'^o; 2 i^'' IN(4 '' NDm20 '^^ *™ 

10 X(IS)=DATA ' ' ST0R 

GO TO 30 ST0R 

C WRITE DATA ON DISC AT LOCATION IS-1500 lino 

20 IST=IS-1500 ST0R 

WRITE(607'IST! DATA ST0R 10 ° 

30 RETURN 5T0R HO 

END ST 0R 120 

// DUP STOR 130 

*STORE WS UA STORE ST0R 14 ° 

STOR 150 
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// FOR SUBROUTINE TO GET A DATUM FROM CORE OR OISC 

*ONE WORD INTEGERS 

C 



GETO 
GETO 

SUBROUTINE TO GET A DATUM FROM CORE OR DISC get0 

IF (IS-1500) 10,10,20 GET0 

10 DATA=X< IS) GETO 

GO TO 30 . , , _.. GETO 

GET DATA FROM DISC AT LOCATION IS-1500 GFT0 1Q0 

1ST=IS-1500 GETO 110 
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READ!607'!T2) DATA 



30 RETURN 
END 
// DUP 
*STORE WS 



UA GET 



GETO 120 
GETO 130 
GETO 140 
GETO 150 



// FOR SECONDARY MAIN PROGRAM - ANALYSIS OF VARIANCE 

*ONE WORD INTEGERS 

*IOCS ( CARD, 1132PR INTER, DISK) 

T AME SECONDARY MAIN PROGRAM -ANALYSIS 0, ; VARIANCE NrNa , NB)NC , 

l C N^?? L E<l^:NxI5:: L "5!IlN;l^,NDIVno" G SM Q R«20,,XDEV (2 1 .X,2000, 

DEFINE FILE 606< 500 ,6,U, I Tl ) 

DEFINE FILE 607 ( 1000, 2 , U, I T2 ) 
100 F0RMATI/2X13HJ0B COMPLETED) 

CALL SDOP 

CALL MNSQ 

CALL REPRT 

HRITE(ITW.IOO) 

CALL EXIT 

END 
// DUP 
*ST0RE MS UA AN0V2 



N0V2 

N0V2 

N0V2 

N0V2 

N0V2 

NOV 2 
N0V2 

N0V2 
N0V2 
N0V2 
N0V2 100 
N0V2 110 
N0V2 120 
N0V2 130 
N0V2 140 
NOV? 150 
N0V2 160 
N0V2 170 
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// FOR SUBROUTINE TO PERFORM SIGMA AND DELTA OPERATIONS 

*ONE WORD INTEGERS 

C SUBROUTINE TO PERFORM SIGMA AND DELTA OPERATIONS 

SUBROUTINE SDOP 

COMMON ICR. IRPt I°R. ITW, IT1, IT2, IPROB, NPAGE, INMD,NF , ITRN ,NA , NB , NC , 
1ND, TITLE! 18),NX(5),LS(5),IN<4>,NDIV(20) , SMQR( 20 ) , XDEV( 20) , X( 1500 ) 
60 NFP1=NF+1 

DO 130 K=1,NF 

NN=NX(K) 

FN = NN 

I S=l 

ISPM=1 
70 SUMX=0. 

DO 30 1=1, NN 

CALL GET (DATA, IS) 

SUMX=SUMX+DATA 

IS=IS + LS(K) 

CALL STORE (SUMX,IS) 

DO 90 1=1, NN 

CALL GET (DATA.ISPM) 

DATA=FN*DATA-SUMX 

CALL STORE (DATA.ISPM) 

ISPM=ISPM+LS!K) 

ITEST= IS-LSINF+1) 

IF ( ITEST) 100,130,130 

IF ( ITEST+LSIK) ) 110,110,120 

IS=IS+LSIK) 

ISPM=ISPM+LSIKI 

GO TO 70 

IS=ITEST+LS(K)+1 

ISPM=ISPM+LS(K)*1-LS(NF<-1 ) 

GO TO 70 
130 CONTINUE 

RETURN 

END 
// DUP 
*STORE WS UA SDOP 



80 



90 



100 
110 



120 



SOOP 





SDOP 


10 


SDOP 


20 


SDOP 


30 


SDOP 


40 


SDOP 


50 


SDOP 


60 


SDOP 


70 


SDOP 


80 


SDOP 


90 


SDOP 


100 


SDOP 


110 


SDOP 


120 


SDOP 


130 


SDOP 


140 


SDOP 


150 


SDOP 


160 


SDOP 


170 


SDOP 


180 


SDOP 


190 


SDOP 


200 


SDOP 


210 


SDOP 


220 


SDOP 


230 


SDOP 


240 


SDOP 


250 


SDOP 


260 


SDOP 


270 


SDOP 


280 


SDOP 


290 


SDOP 


300 


SDOP 


310 


SDDP 


320 


SDOP 


330 


SDOP 


340 


SDOP 


350 


SDOP 


360 



// FOR SUBROUTINE TO COMPUTE MEAN SQUARE SUMMARYS 

*ONE WORD INTEGERS 

C SUBROUTINE TO COMPUTE MEAN SQUARE SUMMARYS 

SUBROUTINE MNSQ 

COMMON ICR,IRP,IPR, ITW , IT 1 , I T2, I PR OB, NPAGE, INMD, NF , ITRN ,NA , N6 , NC , 
1ND, TITLE! 18) ,NX[5) ,LS(5), INI 4) , NDIV( 20) ,SMQR ( 20 ) , XDEVI 20) , X< 1500) 
C CLEAR SUMMARY TABLE 

DO 140 1=1,15 

NDIVI I)=0 
140 SMQR(I)=0.0 

IA=1 

IB=1 

IC = 1 

ID=1 

1=0 

GO TO 160 
150 CALL GET (DATA, I) 

SMQR(K)=SMQR(K)+DATA**2 

XDEV(K)=DATA 

NDIV(K)=NDIV(KI+1 
160 1=1+1 

IF (IA-NA) 170,320,320 
170 IA=IA+l 

IF (IB-NB) 180,250,250 
180 IF (IC-NC) 190,220,220 
190 IF (ID-ND) 200,210,210 
200 K=15 

GO TO 150 
210 K=ll 

GO TO 150 
220 IF (ID-ND) 230,240,240 
230 K=12 

GO TO 150 
240 K=5 

GO TO 150 
250 IF (IC-NC) 260,290,290 
260 IF (ID-ND) 270,280,280 
270 K=13 

GO TO 150 
280 K=6 

GO TO 150 
290 IF (ID-ND) 300,310,310 
300 K=7 

GO TO 150 
310 K=l 

GO TO 150 
320 IA=1 

IF (IB-N8) 330,400,400 
330 IB=IB+1 

IF 1IC-NC) 340,370,370 
340 IF (ID-ND) 350,360,360 
350 K=14 

GO TO 150 
360 K=8 

GO TO 150 



MNSQ 





MNSQ 


10 


MNSQ 


20 


MNSQ 


30 


MNSQ 


40 


MNSQ 


50 


MNSQ 


60 


MNSQ 


70 


MNSQ 


80 


MNSQ 


90 


MNSQ 


100 


MNSQ 


110 


MNSQ 


120 


MNSQ 


130 


MNSQ 


140 


MNSQ 


150 


MNSQ 


160 


MNSQ 


170 


MNSQ 


180 


MNSQ 


190 


MNSQ 


200 


MNSQ 


210 


MNSQ 


220 


MNSQ 


230 


MNSO 


240 


MNSQ 


250 


MNSQ 


260 


MNSQ 


270 


MNSO 


280 


MNSQ 


290 


MNSQ 


300 


MNSQ 


310 


MNSQ 


320 


MNSQ 


330 


MNSQ 


340 


MNSQ 


350 


MNSQ 


360 


MNSQ 


370 


MNSQ 


380 


MNSQ 


390 


MNSQ 


400 


MNSQ 


410 


MNSQ 


420 


MNSO 


430 


MNSQ 


440 


MNSQ 


450 


MNSQ 


460 


MNSQ 


470 


MNSQ 


480 


MNSQ 


490 


MNSQ 


500 


MNSQ 


510 


MNSQ 


520 


MNSQ 


530 


MNSQ 


540 



370 IF (ID-ND) 380,390,390 
380 K=9 

GO TO 150 
390 K=2 

GO TO 150 
400 IB=1 

IF (IC-NC) 410,440,440 
410 IC=IC+1 

IF (IO-ND) 420,430,430 
420 K=10 

GO TO 150 
430 K=3 

GO TO 150 
440 IC=1 

IF (IO-ND) 450,460,460 
450 10=10+1 

K=4 

GO TO 150 
460 CALL GET (DATA, I) 

SMQR(16!=DATA**2 

XDEVf 16)=0ATA 

RETURN 

END 
// DUP 
*STORE US UA MNSQ 



O 



MNSQ 550 
MNSQ 560 
MNSQ 570 
MNSQ 580 
MNSQ 590 
MNSQ 600 
MNSQ 610 
MNSQ 620 
MNSQ 6 30 
MNSQ 640 
MNSQ 650 
MNSQ 660 
MNSQ 670 
MNSQ 630 
MNSO 690 
MNSO 700 
MNSQ 710 
MNSQ 720 
MNSQ 730 
MNSO 740 
MNSO 750 
MNSQ 760 
MNSQ 770 
MNSQ 780 
MNSQ 790 



// FOR SUBROUTINE TO GENERATE ANALYSIS OF VARIANCE TABLES RPRT 

*ONE WORD INTEGERS RPRT 

C SUBROUTINE TO GENERATE ANALYSIS OF VARIANCE TABLES RPRT 

SUBROUTINE REPRT RPPT 

COMMON ICR, IRP, IPR, ITW, IT 1 , I T2, I PROB, NPAGE , I NMD, NF , ITRN , NA , NB, NC , RPRT 

1ND,TITLEU8),NX(5),LS< 5), INI 4) ,NDIV(20) .SM0RI20) ,XDEV ( 20) , X I 15P0 ) RPRT 



COMMON NDFI 151 ,HEAD(4) ,INX( 15) 

101 FORMAT ( 9X,1BA4,5X,3HJ0B, I 7 , 5X , 4HPAGE, 16) 

102 FORMAT!/// 10X, 

13CHANALYSIS OF VARIANCE TABLE FOR, IX, 13, 3H X ,I3,3H X ,13, 
23H X ,I3,11H EXPERIMENT,/// 39X.6HSUM OF ,5X , 10HDEGREES OF , 1 4X , 



RPRT 
RPRT 
RPRT 

RPRT 




10 
20 
30 
40 
50 
60 
70 
80 
90 



RPRT 100 



34HMEAN/13X,9HCOMPONENT,17X,7HSQUARES,5X,7HFREFD0M,15X,6HSQUARE///)RPRT 110 



103 FORMAT ! 4A4, 14, 15 I 2 ) 

104 FORMAT ( 10X , 4A4, 4X, Fl 5. 2, 6X, 15, 7 X ,F 15. 2 ) 

105 F0RMAT(/18X,8HRESIDUAL,4X,F15.2,6X,I5,7X,F15.2) 

106 F0RMATI/21X, 5HT0TAL ,4X ,F 1 5. 2 , 6X, I 5 > 

FORM DEGREES OF FREEDOM VECTOR FOR COMPONENT MEAN SQUARE 

NDF(l)=NX(l)-l 

NDF(2)=NX(2)-1 

N0F!3)^NX(3)-1 

NDF(4)=NX(4)-1 

NDF(5)= NDF(1)*NDF( 2) 

NDF(6)= NDF( 1)*NDF{ 3) 

NDF(7)= NDFI 1)*NDF(4) 

NDF(8)= NDFI2I* NDFI3) 

NDF(9)= NDF!2)*NDF(4> 

NDFI10)= NDFI 3)*N0F!4) 

NDFI 11)= NDF(5)*NDF(3) 

NDFI12)= N0F(5)*NDF(4) 

NDFI 131= NDF(6)*NDF(4) 

NDF(14)= NDF(8)*NDFI4I 

NDF(151= NDF(11)*NDF<4) 

COMPUTE DIVISOR AND INITIALIZE COUNTERS 

NN = 1 

00 6 I = 1,NF 
6 NN = NN *NX(I ) 

FN = NN 

KTDFR = NN - 1 

TOTL = 0.0 

NDFRT = 

COMPUTE TOTAL SUM OF SQUARES FOR ALL COMPONENTS 

TOT = 0.0 

DO 9 I = 1,15 

IF INDIVID) 9,9,85 
85 SMQRII) = SMQR(I) / (NDIVUWN) 

TOT = TOT + SMQRI I) 
9 CONTINUE 

READ LINE CARD AND PRINT COMPONENT 

KSW=0 
8 READ (ICR, 103) (HEAD! I I , I =1 , 4) , I NDI , I INX 1 1 ) , I = 1 , 1 5 I 

SMSQ = 0.0 

NDFI = 

COMPUTE COMPONENT SUM OF SQUARES AND MEAN SQUARE 

DO 20 I = 1,15 

IF (INX(I)) 30,30,10 



RPRT 120 
RPRT 130 
RPRT 140 
RPRT 150 
RPRT 160 
RPRT 170 
RPRT 180 
RPRT 190 
RPRT 200 
RPPT 210 
RPRT 220 
RPRT 230 
RPRT 240 
RPRT 250 
RPRT 260 
RPRT 270 
RPRT 280 
RPRT 290 
RPRT 300 
RPRT 310 
RPR T 320 
RPRT 330 
RPRT 340 
RPRT 350 
RPRT 360 
RPRT 370 
RPRT 330 
RPRT 390 
RPRT 400 
RPRT 410 
RPRT 420 
RPRT 430 
RPRT 440 
RPRT 450 
RPRT 460 
RPRT 470 
RPRT 480 
RPRT 490 
RPRT 500 
RPRT 510 
RPRT 520 
RPRT 53,0 
RPRT 540 



1C 


K=INX( 




SMSQ = 


20 


NDF1=NI 


30 


SMSQM=: 


C 


WRITE " 




IFCIND 


31 


NPAGE=' 




CALL Fl 




IF( IPR 


32 


WRITE 


40 


IFCKSW 


402 


WRITE( 




KSW=1 


401 


WRITE! 




TOTL = 




NDfRT 




IF1 INO 


C 


PRINT i 


50 


IOIF = 




IF ( ID 


51 


SMSQ = 




SMSQM 




WRITE 


52 


WRITE 




RETURN 




END 


// DUP 


*STORE 



I) 

SMSQ + SMQR(K) 
DFl+NDF(K> 
SMSQ/NDF1 

TITLE LINE AND COLUMN HEADINGS 
I I 40,40,31 
NPAGE+1 
MATI IPR.ITW) 
) 32,32i40 

(ITW.lOl) TITLE, IPROB.NPAGE 
1401,402,401 
ITW,102) (NX(I 1,1=1,4) 

ITW.104) ( HE AD (I), I =1,4) , SMSQ, NDF 1 , SMSQM 

TOTL + SMSQ 
= NDFRT + NDF1 
I) 50,8,3 
RESISUAL AND/OR TITLE LINE 

KTDFR - NDFRT 
IF) 51,52,51 

TOT - TOTL 
= SMSQ / IDIF 
(ITW,1051 SMSQ, IDIF, SMSQM 
(ITW.106) TOT, KTDFR 



WS UA REPRT 



RPRT 550 
RPRT 560 
RPRT 570 
RPRT 580 
RPRT 590 
RPRT 600 
RPRT 610 
RPRT 620 
RPRT 630 
RPRT 640 
RPRT 650 
RPRT 660 
RPRT 6T0 
RPRT 690 
RPRT 690 
RPRT 700 
RPRT 710 
RPRT 720 
RPRT 730 
RPRT 740 
RPRT 750 
RPRT 760 
RPRT 770 
RPRT 780 
RPRT 790 
RPRT 800 
RPRT 810 
RPRT 820 



// FOR IN"UT DATA SUBROUTINE 
*IOCS(CAR0,1132PRINTER,DISK) 
♦ONE WORD INTEGERS 
*NAME FCTR 



FCTR 
FCTR 
FCTR 
FCTR 
FCTR 
FCTR 
FCTR 
FCTR 



; INPUT DATA SUBROUTINE 

DEFINE FILE 606( 500 ,65 , U, IT 1 ) 

DEFINE FILE 5 ( 30 , 60 ,U , I T2 ) 

COMMON ICR, ICP, IPR, ITW, IT1, IT2, I PROS ,N, NF ,CASE S , NPAGE, I NMD, IPRED 
1ICOM,IROT,NFRT,KX(1),MX(20),NCD!3), I SEQ, NCASE ,KCNT , NX ( 9 ) , FCTR 

1TRC,FLVB(4),KNN FCTR 

COMMON TITLE(18),VNAME(30),SUMY( 30) , SD( 30) , X( 30) ,R!30,30) FCTR 

COMMON HIGHI30) ,H LOW! 30 ) , MF ( 50, 3 ) FCTR 

101 F0RMAT16I2) FCTR 

102 FORMAT! 14, 4X.18A4) FCTR 

103 F0RMATI31I2) FCTR 

104 F0RMATI20A4) FCTR 

105 FORMAT! 1CX, 18 A4 ,5X , 3HJ0B , 17, 5X, 4HPAGE, I 6// 1 IX , 19HNUMBER OF VARFCTR 
1IABLES,46X,I2/11X,10HINPUT TYPE , 55X , I 2/1 IX , 14HSEQUENC E CHECK 51XFCTR 
2I2/11X,19HVARIABLES ON CARD 1 46X , I 2/1 1X19HVARI ABLE S ON CARD 2 46XFCTR 
3I2/11X, 19HVARIABLES ON CARD 3 46X , I 2/ 1 IX , 2 1HTRANSF0RMAT ION SWITCH, FCTR 
444X,I2! FCTR 

106 FORMAT! 11X.13HFACT0R SCORES 52X , I 2/ 1 IX , 24HNUMBER OF FACTORS OPTIONFCTR 

1 41X, I2/UX,37HNUMBER OF FACTORS OR PERCENT OF TRACE 28X, 12/ 1 IX , 18FCTR 
2HC0MMUNALITY OPTION 47X , I 2/ 11X, 1 5HR0TATI ON OPTION 50X , I 2/11X , 27HNUFCTR 
3MBER OF FACTORS TO ROTATE 38X, I 2/ 1 1 X, 14HP0CL I NG OPTION FCTR 
451X,I2/11X,14HLATENT VECTORS 5 IX , I 2/1 IX , 23HUNR0TATED FACTOR MATRIXFCTR 
5 42X,I2/11X,32H0RTH0G0NAL TRANSFORMATION MATRIX 33X,I2) FCTR 

107 FORMAT! 11X,24H0RTH0G0NAL FACTOR MATRIX 41X , I 2/1 1 X .59HTRANSF0RMATI OFCTR 
IN MATRIX TO OBLIQUE REFERENCE VECTOR STRUCTURE 6X , I 2/11 X, 41H0BL IQUFCTR 
2E REFERENCE VECTOR STRUCTURE MATRIX 24X , I 2/ 1 IX, 44HC0RRELAT IONS AMOFCTR 
3NG OBLIQUE REFERENCE VECTORS 21X , I 2/1 IX , 39H0BLI QUE REFERENCE VECTDFCTR 
4R PATTERN MATRIX 26X, 1 2/1 IX, 58HC0RRELATI ONS BETWEEN REFERENCE VECTFCTR 
50RS AND PRIMARY FACTORS 7X,I2) FCTR 

108 FORMAT!///' AN ILLEGAL CHARACTER HAS BEEN ENCOUNTERED AT APPROX IMAFCTR 
1TELY COLUMN 1 , 13,' OF THE ABOVE DATA CARD. 1 /' CHANGE OR REMOVE CARDFCTR 

2 AND PRESS START TO CONTINUE.') FCTR 

109 FORMAT ( 1 IX , 39H0BL IOUE PRIMARY FACTOR STRUCTFCTR 
1URE MATRIX 26X,I2/11X,42HCORRELATIONS AMONG OBLIQUE ORIMARY FACTORFCTR 
2S 23X,I2/11X,37H0BLIQUE PRIMARY FACTOR PATTERN MATRIX 28X , I 2/11X, 3FCTR 
36HFACTOR SCORE REGRESSION COEFFICIENTS 29X.I2) FCTR 

110 FORMAT (11X,25H0UTPUT RAW CROSS PRODUCTS 40X,I2/11X 30H0UTPUT RESIFCTR 
1DUAL CROSS PR0DUCTS35X,I2/11X,23H0UTPUT VARIANCE - COVARI ANCE37X , I FCTR 
22/11X, 18H0UTPUT CORRELATION 47X.I2) FCTR 

111 FORMAT!/// 5X 4HCARD HO, 14, IX 30HIS OUT OF SEQUENCE. RERUN JOB. FCTR 
1 ) FCTR 

112 FORMAT!///' AN ILLEGAL CHARACTER HAS BEEN ENCOUNTERED IN COLUMN", FCTR 

113,' OF THE ABOVE FORMAT CARD.'/' CHANGE CARD AND RERUN JOB.') FCTR 

113 FORMAT!//' INVALID INPUT OPTION-JOB TERMINATED •) FCTR 

; SUBROUTINE TO READ PARAMETER CARDS (FACTOR ANALYSIS) FCTR 

NPAGE = FCTR 

READ!2,101) ICR,ICP,IPR,ITW,IU,IT2 FCTR 

IF! IPR)701,702,701 FCTR 

702 ITW=3 FCTR 

GO TO 703 FCTR 

701 ITW=1 FCTR 
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►o 



703 READIICR.102) IPROB, TITLE 

READ UCR, 103) N.INMD, ISEQ,(NCD(I) , I =1 , 3 1 , MX I 20) , ( MX I I ) , 1= 1 , 4 ) , 
1IPRED,NF,KCNT,IC0M,IR0T,NFRT,NX( 1 ) , ( MX ( I ) , I =5, 1 7) 

CALL FMATI IPR, ITW) 

WRIT£( ITW, 105) TITLE,IPROB,NPAGE,N,INMD,ISEQ,INCD< 11,1=1,3) , 
1MXI20I 

WRITEIITW.UOI IMXII), 1=1,4) 

WRITE! ITW, 106) IPRED,NF,KCNT,IC0M,IR0T,NFRT,NX(1) ,(MX(I) ,1=5,7) 

WRITEIITW.107) (MX( 11,1=8,13) 

WRITE(ITW,109) (MX( I), 1=14, 17) 

REAOUCR,104) (VNAME(I),I=1,N) 

IF(INMO-l) 1,1,1001 

1001 IF1INMD-4) 5,1002,1002 

1002 WRITE(ITW,113) 
CALL EXIT 

1 DO 4 1=1,3 

CALL FMTRDIMFILI), IRR) 
CALL PRNTB 
IFIIRR) 2,3,2 

2 WRITE! ITW, 1121 IRR. 

CALL EXIT 

3 IFINCDI 1+1) ) 5,5,4 

4 CONTINUE 

; INITIALIZATION 

5 DO 8 1=1, N 
HIGH(I) = 0. 
HLOWI I) = 1.0E+36 
SUMY( I) = 0. 

SDI I)=0.0 
DO 8 J=1,N 

8 R(I,J) = 0.0 
KOUNT = 
CASES = 0. 
NCASE = 

9 IT1 = 1 

10 GO TO I 11,41,51),INMD 
; CARD READER INPUT 

11 1ST = 1 
1 = 1 

IFINCDI 1) ) 12,12,13 

12 NCD( 1) = N 

13 CALL DATRD(MFU,1),IRR,ID,1,NC1 , X , -NCDU ) ,0 , ) 
IFIIRR) 14,15,14 

14 CALL PRNTB 
WRITE(ITW,108) IRR 
PAUSE 10 

GO TO (13,18,18), I 

15 IF( ID) 150,16,16 

16 DO 22 1=2,3 

IF I NCDU)) 23,23,17 

17 1ST = NCDtI-1) + 1ST 

18 CALL DATRDIMFU.I), IRR , I Dl , 1 ,NC 1 , 1 , X ( I ST ) ,-NCD I I ) ,0 ,0 ) 
IFIIRR) 14,19,14 

19 IF(ISEQ) 22,22,20 

20 IF(lD-IDl) 60,21,60 



FCTR 


550 


FCTR 


560 


FCTR 


570 


FCTR 


5 80 


FCTR 


590 


FCTR 


600 


FCTR 


610 


FCTR 


620 


FCTR 


630 


FCTR 


640 


FCTR 


650 


FCTR 


660 


FCTR 


670 


FCTR 


680 


FCTR 


690 


FCTR 


700 


FCTR 


710 


FCTR 


720 


FCTR 


730 


FCTR. 


74.0 


FCTR 


750 


FCTR 


760 


FCTR 


770 


FCTR 


780 


FCTR 


790 


FCTR 


800 


FCTR 


810 


FCTR 


820 


FCTR 


830 


FCTR 


840 


FCTR 


350 


FCTR 


860 


FCTR 


870 


FCTR 


880 


FCTR 


890 


FCTR 


900 


FCTR 


910 


FCTR 


920 


FCTR 


930 


FCTR 


940 


FCTR 


950 


FCTR 


960 


FCTR 


970 


FCTR 


980 


FCTR 


990 


FCTR1000 


FCTR1010 


FCTR1020 


FCTR1030 


FCTR1040 


FCTR1050 


FCTR1060 


FC T R1070 


FCTR1080 


FCTR1090 



21 IF(NCl-NC) 60,60,6 
6 ID = ID1 

NC = NCI 

22 CONTINUE 
GO TO 23 

60 WRITE(ITW,111) ID1,NC1 
CALL EXIT 

23 IFIMX120)) 230,231,230 

230 CALL TRAN 

231 IFUNMO-2) 27,30,27 

27 WRITE(606'IT1) ID , (XII), 1=1, N) 
C COMPUTE CROSS PRODUCT MATRIX 
30 CASES = CASES + 1. 

NCASE = NCASE + 1 

DO 35 I = 1,N 

SUMY(I) = SUMY(I) + XI I) 

DO 35 J=I,N 

R(I, J) = R(I,J] + X(I)*X( J) 

35 R(J,I) = RII.J) 

C DETERMINE HIGH AND LOW VALUES 

DO 39 1=1, N 

IFIX(I) - HIGH! I) ) 37,37,36 

36 HIGH! I ) = XII) 

37 IF(XU) - HLOWI I 1)38,39,39 

38 HLOWt I) = XI I) 

39 CONTINUE 
GO TO 10 

C READ DATA FROM DISK OR TAPE! 360) 
41 READI606' IT1) ID , ( X ( I ) , I =1 ,N) 
IF ( ID ) 43,43,23 

43 m=i 

GO TO 200 
C READ A MATRIX FROM CARDS 
51 IX0T=IROT 
IR0T=NX(1) 
CALL MXRAD 
IROT=IXOT 
IFt INMD-2)150,151,151 

150 WRITE1606' Wl) ID , I X ( I ) , I =1 , N) 

151 (Tl = 1 

200 IF(NCASE)400,400,300 
300 KNN=1 

CALL LINK(COREL) 
400 CALL LINK(FCTRl) 
END 
// DUP 
*STORE WS UA FCTR 



FCTR1100 
FCTR1110 
FCTR1120 
FCTR1130 
FCTRU40 
FCTR1150 
FCTR1160 
FCTR1170 
FCTR1180 
FCTR1190 
FCTR1200 
FCTR1210 
FCTR1220 
FCTR1230 
FCTR1240 
FCTR1250 
FCTR1260 
FCTR1270 
FCTR1280 
FCT»1290 
FCTR1300 
FCTR1310 
FCTR1320 
FCTR1330 
FCTR1340 
FCTR1350 
FCTR1360 
FCTR1370 
FCTR1380 
FCTR1390 
FCTR1400 
FCTR1410 
FCTR1420 
FCTR1430 
FCTR1440 
FCTR1450 
FCTR1460 
FCTR1470 
FCTR1480 
FCTR1490 
FCTR1500 
FCTR1510 
FCTR1520 
FCTR1530 
FCTR1540 
FCTP1550 
FCTR1560 



// FOR FACTOR ANALYSIS SETUP PROGRAM 

*ONE WORD INTEGERS 

♦IOCSICARO, L132PRINTERiOISK) 

♦NAME FCTR1 

C FACTOR ANALYSIS SETUP PROGRAM 

DEFINE FILE 606( 500 ,65 ,U, IT1 I 

DEFINE FILE 51 30r 60 ,U, 1T2) 

COMMON ICR.ICP.IPR, ITW,UiaT2, IPROB.N.NF, CASES, NPAGE.INMD.ISCR, 
1IC0M,IR0T,NFRT,KXU),MX120),NCD1,NCD2,NCD3,ISEQ,NCASE,KCNT,NX(9), 

'COMMON TITLE(18),VNAME(30),SUMY(30),SD(30>,DATA(30>,R(30,30) 
COMMON Y130), 800001 30), BC002 
<5 IFUCOM - II 30,10,20 
C MAXIMUM ROM ELEMENT AS COMMUNALITY 

10 R(N,N) = 0. 
00 12 1=1, N 

RII.I) = ABSIRII.NI) 

DO 12 J=1tN 

IF(ABSIR(I,J)) - RII.ID 12,12,11 

11 RII.I) = ABSiRII.Jii 

12 CONTINUE 
GO TO 30 

C SQUARED MULTIPLE CORRELATION AS COMMUNALITY 
20 CALL INVRSIR, DATA, N, IERR) 
00 21 1=1, N 
R(l,U =1.-1. /RII.I) 
DO 21 J=I,N 
*«• 21 RCI.J) =R(J,I) 
w C COMPUTE TRACE OF THE MATRIX TO BE FACTORED 

30 TRC = 0. 

00 31 1=1, N 

31 TRC = TRC + RCI»I 1 

C COMPUTE EIGENVALUES. 

CALL TRIDI 

CALL QR 

CALL LINK (FCTR2) 

END 
// DUP 
♦STORE WS UA FCTR1 
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// FOR 

♦ONE WORD INTEGERS 

SUBROUTINE INVRSI R, X,NROW, IERR ) 

DIMENSION R(30,30),X(305 

IERR = 

DO 10 K=2,NR0W 

M=K-1 

DO 3 KK=1,M 

XIKK) =0.0 

DO 3 J=1,M 

IFIKK-J) 4,4,5 

5 XIKK) = X(KK) +R(J,KK)*R(J,K) 
GO TO 3 

4 XIKK) =X(KK) <-R(KK,J)*R!J,K> 
3 CONTINUE 

ALPHA = R(K,K) 

DO 6 1=1, H 

6 ALPHA = ALPHA -X(I)*R1I,K) 
IFIABSi ALPHA)-L.0E-8) 7,7,8 

7 IERR = 1 
GO TO 20 

C CALCULATE LAST COLUMN OF NEXT INVERSE 

8 DO 9 1 = 1, M 

R(I,KI =-XU)/ALPHA 
C RECALCULATE PREVIOUS INVERSE 

DO 9 J=I,M 

9 R(I,J) =R(I.J> +IXII)*XU1)/ALPHA 

C CALCULATE R(K,K) ELEMENT OF NEXT INVERSE 
R(K,K) =1.0/ALPHA 
10 CONTINUE 
20 RETURN 
END 
'/ DUP 
*STORE WS UA INVRS 
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// FOR XMAX 
♦ONE WORD INTEGERS 

FUNCTION XMAX(A,B) 
XMAX = A 
IF(A-B)2,l,l 
2 XMAX = B 
1 RETURN 
END 



// OUP 
♦STORE 



WS UA XMAX 
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// FOR TRANSFORM MATRIX TO TRIDIAGONAL FORM 
*ONE WORD INTEGERS 

REDUCES A REAL SYMMETRIC N BY N MATRIX TO TRIDIAGONAL FORM USING 

N - 2 ELEMENTARY ORTHOGONAL TRANSFORMATIONS. THE DIAGONAL 

ELEMENTS AND THE SUBDI AGONAL ELEMENTS ARE STORED IN ARRAYS 

ALPHA AND BETA RESPECTIVELY 

SUBROUTINE TRIDI 

OIMENSION GAM(30),V(30) 

COMMON ICR,ICP,IPR, ITW, IT1, IT2, IPROB, N,NF,C ASES , NPAGE, I NMD, I SCR, 
1ICOM,IROT,NFRT,KX(1),MX(20),NX(15),TRC,FLVB(4),KNN 

COMMON TITLE(18I,VNAME(30I,SUMY( 30 ) , SD! 30) ,P (30) ,R I 30, 301 

COMMON ALPHA(301,BETA(30),AN0RM 

ANORM=0.0 

ABSB=0.0 

L=N-2 

DO 4 K=1,L 

ALPHA(K) = R(K,K) 

SIGMA =0.0 

LL=K+1 

DO 5 I-LL.N 
5 SIGMA = RU,K)*R(I,K)+SIGMA 

ABSB = SORT! SIGMA) 

T = ABS(ALPHAIK) ) + ABSB 

ANORM = XMAX(ANORM,T+ABSB) 

A = R(KH,K) 

B = SIGN(ABSB.-A) 

BETA(K) = B 

IF(SIGMA) 8,4,8 
8 GAMMA = 1.0 / (SIGMA - A*B) 

GAM(K)=GAMMA 

R(K+L,K»=A - B 

T=0. 

DO 13 I=LL,N 

P(I) = 0. 

00 11 J=LL,I 

11 P(I) = P(I) + R(I,J)*R(J,K) 
IF(I-N) 110,10,10 

110 LI = I + 1 

DO 12 J=L1,N 

12 P(I) = P(I) + R(J,I)*R(J,K) 
10 P(I) =P(I!*GAMMA 

13 T = T + P(I) * R(I,KI 
T = . 5*GAMMA *T 

QO 14 I=LL,N 

Pill = P(I) - T*R(I,K) 

DO 14 J=LL,I 

14 R( I,J)=RII,J) - R(I,K)*P(J) 
WRITE(5«K)(R(J,K),J=1,N) 

4 CONTINUE 

ALPHA(N-1)= R(N-1,N-1! 

BETA(N-l) = R(N,N-1) 

ALPHAIN) = R1N.N) 

BETA(N)=0 

T = ABSIBETA(N-l) ) 

ANORM=XMAX(AN0RM , XMAX ( ABSB*T+ABS( ALPHA (N- L I ) , T+ABS( ALPHA! N) 1 ) 



RIJ,K)*P( I) 
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FORM TRANSFORMATION MATRIX 8Y APPLYING THE TRIDIAGONAL IZ I NG 
ROTATIONS TO AN IDENTITY MATRIX. 
DO 402 1=1, N 
DO 403 J=1,N 
403 RII,J)=0.0 
402 RI I, 11=1.0 

DO 409 1=1, L 
READI5' IHV(J),J=1,N) 
1 



II = I 
DO 409 
P(J)=0 
DO 408 
408 P!J) = 
P!J) = 
DO 409 



J=2,N 


K=II,N 

P(J) + R(J,K)*V(K) 
PIJ) * GAM(I) 
K= 1 1 , N 

409 R(J,K) = R(J,K) - P(J)*V!K) 
RETURN 



END 



// DUP 
* STORE 



WS UA TRIDI 
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R FIND EIGENVALUES OF TRIDIAGONAL MATRIX 
WORD INTEGERS 

FINDS THE EIGENVALUES OF A TRIDIAGONAL MATRIX BY THE QR METHOD 

SUBROUTINE QR 

DIMENSION A(30),B(30) 

COMMON ICR, ICP.IPR, ITH, IT1, IT2, IPROB,N, NF .CASES, NPAGE.I NMD. I SCR , 
1 ICOM , I ROT , NF RT , KX ( 1 ) , MX ( 20) , NX ( 1 5 ) , TRC , FLVB ( 4) , KNN 

COMMON TITLE! 18 ) , VNAME ( 30) , SUMY{ 30! , SDI 30) , XI 30) ,R< 30, 30) 

COMMON ALPHAI30) ,3ETA(30) ,ANORM 

EPSQ = AN0RM*AN0RM*7.5E-14 

SET INTERNAL ARRAYS A AND B TO ALPHA AND BETA**2 RESPECTIVELY. 

00 542 1=1, N 
ACI )=ALPHA(I) 
B(I) = BETA(I) * BETAU) 
AMU =0.0 

M = N 
IF(M-l) 100,100,2 

1 = M - 1 
K = I 
Ml = K 
!F<B(K!-EPSQ)3,3,4 
X(M) = ACM) 

AMU =0.0 

M = K 

GO TO 1 

1 = 1-1 

IF(I)7,7,5 

IF(B( II-EPSQ)7,7,6 

K = I 

GO TO 4 

IF(K-M1>9,8,9 

HANDLE 2 BY 2 BLOCK SEPARATELY. 

AMU = A[M1)*A(M) - B(M1) 

SQ1 » ACMll+AIM) 

SQ2 = A(Ml)-AIM) 

S02 = SQRT(SQ2*SQ2 + 4.0*B(MD) 

ALAMB = .5*(SQ1+SIGN(SQ2,SQ1) 1 

XIM1)=ALAMB 

X(M) = AMU/ALAMB 

AMU=0.0 

M = M - 2 

IFIM110L, 101,1 

SHORTCUT SINGLE QR ITERATION. 

ALAMB = 0.0 

IF(ABS(A(M)-AMUI 



10 ALAMB = AIM) 

11 AMU = AIM) 
SQ1=0 
SQ2 = 

U = 
DO 20 
GAMMA 



5*ABS(A(M)) ) 10,10,11 
.5*SQRTIBIM1)I 







I=K,M1 

= AID-ALAMB-U 
IFISQ1-1.0) 12,13,12 
12 PQ = GAMMA*GAMMA/(1.0-SQ1) 
GO TO 15 
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VI 



13 


PQ = 0.0 




IFU-1)15,15,14 


14 


PQ = ( 1.0-SQ2)*B( 1-1) 


15 


T = PQ + B(I) 




IFII-1)17,17,16 


16 


B( I-1) = SQ1*T 


17 


SQ2 = SQ1 




SQ1 = 81 I)/T 




U = SQ1 * (GAMMA + AII+11 - ALAMB) 




All) = GAMMA + U * ALAMB 


20 


CONTINUE 




GAMMA = AIM) -ALAMB-U 




IFISQ1 - 1.0)21,22,21 


21 


B(Ml)=SQl*r.AMMA*r,AMMA/ll.O-SQl> 




GO TO 23 


22 


BIM1) = SQ1*8!M1)*I 1.0-SQ2) 


23 


AIM) = GAMMA * ALAMB 




GO TO 1 


100 


XI1)=A(1) 


c 


PLACE EIGENVALUES IN ORDER OF DESCENDING VALUE 


101 


DO 110 K=1,N 




XMX = -1000. 




DO 105 J=K,N 




IF(XIJ) - XMXI 105,105,103 


103 


XMX = XU) 




JJ = J 


105 


CONTINUE 




X(JJ)=X!K) 




XIK)=XMX 


no 


CONTINUE 




RETURN 




END 


// DUP 


•STORE WS UA OR 



QROO 550 // FOR FACTOR ANALYSIS OUTPUT PROGRAM 

QROO 560 *I0CS(CARD,1132PRINTER,DISK> 

QROO 570 *ONE WORD INTEGERS 

QROO 580 *NAME FCTR2 

QROO 590 C FACTOR ANALYSIS OUTPUT PROGRAM 

ORCO 600 DEFINE FILE 6061 500 ,65, U, IT1 1 

QROO 610 DEFINE FILE 51 30, 60 ,U, I T2 I 

QROO 620 DIMENSION YI30) 

QROO 630 COMMON ICR , ICP, IPR, I TW, IT 1, IT2 , I PROS ,N, NF , CASES , NPAGE, I NMD, I SCR , 

QROO 640 1ICOM,IROT,NFRT,KX!1),MXI20),NCD1,NCD2,NCD3,ISEQ,NCASE,KCNT,NX(9), 

QROO 650 1TRC,FLVBI4),KNN 

QROO 660 COMMON T I TLEI 18 I , VN AME I 30 ) , SUMY! 30) , SD( 30) , X I 30 ) , R I 30, 30 1 

QROO 670 COMMON Bl I 30 ) , B2I 30 ) , B3 

QROO 680 100 FORMAT1/2X13HJOB COMPLETED) 

QROO 690 101 FORMAT! 10X, 18A4 ,5X , 3H JOB, I 7, 5X, 4HPAGE , 16 ) 

QROO 700 102 F0RMAT!//40X,5HTRACE,F15.4,/> 

ORCO 710 103 F0RMATI38X,F15.4,15X,F15.4) 

QROO 720 104 F0RMATI38X.20HCHARACTERISTIC ROOTS 10X, 23HCUMIJL . PERCENT OF TRACE 

QROO 730 3 /, ■ ■ /) 

QROO 740 105 FORMAT! /10X13HCQMMUNALITIES/) 

OROO 750 106 FORMAT! 2X,A4, 5X,E 15 . 7) 

QRCO 760 C DETERMINE NUMBER OF FACTORS TO COMPUTE 

QROO 770 DO 21 1=1, N 

ORCO 780 21 Yd) = 0.0 

OROO 790 [FINF-2)32,33,40 

QROO 800 32 NF = 

QROO 810 KCNT = 

QROO 820 GO TO 50 

QROO 830 33 NF = KCNT 

QROO 840 KCNT = 

QROO 850 GO TO 50 

QROO 860 40 NF = 

QROO 870 50 SUM = 0. 

QROO 880 PCNT = KCNT 

DO 8 J=1,N 

IF(XU) ) 1,1,2 

1 NF = J-l 
GO TO 9 

2 IF(NF) 4,4,3 

3 IFINF-J) 9,7,7 

4 IFIKCNT) 5,5,6 

5 IF(XU) - 1.0) 1,7,7 

6 IF(YIJ) - PCNT) 7,1,1 

7 SUM = SUM + XI J) 

8 YIJ) = SUM*100./TRC 

C COMPUTE CHARACTERISTIC VECTOR FOR FIRST NF CHARACTERISTIC VALUES. 

9 CALL VECTR 

C OUTPUT CHARACTERISTIC VECTORS 

CALL PRNTI5,0,N,NF) 
C COMPUTE FACTOR COEFFICIENTS 

DO 80 J=1,NF 

SQTXJ = SQRTIX(J) ) 

DO 80 1=1, N 
80 R(I ,J) = R(I,J)*SQTXJ 
C OUTPUT CHARACTERISTIC VALUES 
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OIFE = TRC - SUM 
NPAGE = NPAGE * 1 
CALL FMAT1 IPR, ITW) 
IFIIPR) 81,81,82 

81 WRITEIITW.lOl) TITLE, IPROB, NPAGE 

82 WRITE(ITW,102)TRC 
WRITEUTW,104) 

DO 90 1=1, N 
90 «/RITE(ITW,103) X(II,V(II 

C OUTPUT FACTOR MATRIX 

CALL PRNT(6,0,N,NF> 
WRITE(ITW,105) 
DO 52 I=1,N 
COM=0. 
00 51 J=l,NF 

51 COM=COM+R( I,J)**2 
WRITE(ITW,106)VNAME(I),C0M 

52 CONTINUE 
IF!IR0T)16,17,16 

16 CALL LINKIFCTR3) 
1? WRITE( !TW, 100) 

CALL EXIT 

END 
// DUP 
*STORE MS UA FCTR2 
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// FOR SUBROUTINE TO OUTPUT RESULTS OF ROTATION 
*ONE WORD INTEGERS 

SUBROUTINE TO OUTPUT RESULTS OF ROTATION 

SUBROUTINE RFOUT 

COMMON ICR.ICP.IPR, ITW,IT1,IT2,IPR0B,N,NF,CASES,NPAGE,INMD,ISCR, 
1ICOM,IROT,NFRT,KX(1),MX(20),NX( 15) ,TRC,FLVB(4) ,KNN 

COMMON TITLEI18),VNAME(30),SUMY( 30) , SD( 30 ) , H( 30 ) , A ( 30 , 10) 

COMMON 8(10,10) ,E(10, 10) 

IF KXll) = ENTRY FROM VARMX 

IF KX(1) = 1 ENTRY FROM PRDMX 

IF(KXd)) 1,1,10 

1 CALL RPRNT(B,7,1,NFRT,NFRT) 
OUTPUT ORTHOGONAL FACTOR MATRIX 
CALL RPRNT ( A, 8 ,0 ,N ,NFRT ) 

SET B-MATRIX TO IDENTITY FOR FACTOR SCORES 
DO 4 I=1,NFRT 
DO 4 J=1,NFRT 
IF(I-J) 3,2,3 

2 B(I,J) = 1.0 
GO TO 4 

3 Btl.Jl =0. 

4 CONTINUE 
GO TO 100 
OUTPUT OBLIQUE TRANSFORMATION MATRIX 

10 CALL RPRNT(B,9, 1,NFRT,NFRTI 
OUTPUT CORRELATIONS AMONG OBLIQUE REFERENCE VECTORS 
CALL RPRNT(E,11,1,NFRT,NFRT) 

OUTPUT OBLIQUE REFERENCE VECTOR STRUCTURE MATRIX 
CALL RPRNT(A,10,0,N,NFRT) 

COMPUTE INVERSE OF REFERENCE VECTOR CORRELATIONS 
CALL MATIN(E,NFRT) 

COMPUTE REFERENCE VECTOR PATTERN MATRIX (W) 
DO 5 I=1,NFRT 

5 WRITE^'I) (A(J,I ), J=1,N> 
DO 12 1=1, N 
DO 11 J = l.NFRT 
H(J) = 0.0 
DO 11 K = l.NFRT 

11 HIJ) = H( J) + All ,K) * E(K,J) 
00 12 J = 1,NFRT 

12 Ad, J) = HIJ) 
CALL RPRNT(B,12,0,N,NFRT) 

COMPUTE COR. AMONG REFERENCE VECTORS AND PRIMARY FACTORS 
DO 15 I = l.NFRT 
DO 15 J = 1,NFRT 
IF (I-J) 14,13,14 

13 B( It I ) = 1. / SQRTI El 1,1 ) 1 
GO TO 15 

14 Bl I, J) = 0^0 

15 CONTINUE 
CALL RPRNT(B,13,1,NFRT,NFRT) 
COMPUTE COR. AMONG PRIMARY FACTORS 
DO 21 I = l.NFRT 

21 H(I) = B(I,I) 
DO 20 I=1,NFRT 
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00 20 J = l.NFRT 
IF (I-J) 16,17,16 

16 B(I,J) = E(I,J) *H( I)*H(J) 
GO TO 20 

17 BII,I ) = 1.0 
20 CONTINUE 

CALL RPRNT(Btl5,l,NFRT,NFRT) 
C COMPUTE PRIMARY FACTOR STRUCTURE MATRIX 

00 30 I = 1,NFRT 

DO 30 J = 1,N 
30 A(J,I! = AIJ, I) * Hill 

CALL RPRNT ( B, 14, 0, N.NFRT I 
C COMPUTE PRIMARY FACTOR PATTERN MATRIX 

00 40 I = 1,NFRT 

REA0(5'I) (AIJ,I),J=1,N) 

00 40 J = 1,N 
40 AIJ, I) = A(J,I1/H([1 

CALL RPRNT(B,16,0,N,NFRT) 
100 RETURN 

END 

// DUP 

*STORE WS UA RFOUT 



(S) 



03 



ROUT 550 
ROUT 560 
ROUT 570 
ROUT 580 
ROUT 590 
ROUT 600 
ROUT 610 
ROUT 620 
ROUT 630 
ROUT 640 
ROUT 650 
ROUT 660 
ROUT 670 
ROUT 680 
ROUT 690 
ROUT 700 
ROUT 710 
TOUT 720 
ROUT 730 
ROUT 740 
ROUT 750 
ROUT 760 



00 7 
G(J) 
00 7 
GUI 



// FOR SUBROUTINE FOR OBLIQUE ROTATION (PROMAX) 

*ONE WORD INTEGERS 

C SUBROUTINE FOR OBLIQUE ROTATION (PROMAX) 

SUBROUTINE PROMX 

COMMON ICR.ICP.IPR, ITW, IT1.IT2, I PROS, N, NF , CASES , NPAGE, I NMD , I SCR , 
1ICOM,IROT,NFRT,KX(1),MX(20I ,NX( 15) , TRC, FLVB ( 4 ) , KNN 

COMMON TITLE! 18 ) , VNAME ( 30 ) , SUMYI 30 ) , SD( 30 ) ,H ( 30) ,A ( 30 , 1 0) 

COMMON B( 10, 10) ,E( 10,10) ,G1 101 
C COMPUTE A-TRANSPOSE * A 
21 DO 1 I=1,NFRT 

DO 1 J=1,NFRT 

8(1, J) =0. 

DO 1 K=1,N 

1 B(I,J! = B(I,J) + A(K,I) * A(K,J) 
CALL MATIN(B,NFRT) 

00 2 I=1,NFRT 
DO 2 J=1,NFRT 
E(I,J)=0. 
DO 2 K=1,N 

2 E(I,J)=E(I,J)+A(K,I )*SIGNU IABSC A1K, J)) 1**4 ) , A ( K, J ) ) 
DO 8 1= l.NFRT 

J=1,NFRT 

0. 
K=1,NFRT 

GUI + B(I ,K)*E(K,J) 
00 8 J=1,NFRT 

8 BUt J) = G(J) 
DO 10 J=1,NFRT 
T=0. 

DO 9 I=1,NFRT 

9 T = T * B(I,J)**2 
T=SQRT(T) 

DO 10 I=1,NFRT 

10 B(I,J) = B( I, J)/T 

C APPLY TRANSFORMATION MATRIX T3 FORM REFERENCE VECTOR STRUCTURE 
C MATRIX 

DO 12 1=1, N 

00 11 J=1,NFRT 

G(J) = 0. 

DO 11 K=1,NFRT 

11 G(J) = G(J) + A(I,K)*B(K,J> 
DO 12 J=1,NFRT 

12 A(I,J) = GUI 

C COMPUTE CORRELATIONS AMONG REFERENCE VECTORS 
00 13 I=1,NFRT 
DO 13 J=1,NFRT 
E(I,J) = 0. 
00 13 K=1,NFRT 

13 E(I,J) = Ed, J) + BIK.I )*B(K,J) 
KXI1) = 1 

RETURN 

END 
// DUP 
♦STORE WS UA PROMX 



PRMX 


C 


PRMX 


10 


PRMX 


20 


PRMX 


30 


PRMX 


40 


PRMX 


50 


PRMX 


60 


PRMX 


70 


PRMX 


80 


PRMX 


90 


PRMX 


100 


PRMX 


no 


PRMX 


120 


PRMX 


130 


PRMX 


140 


PRMX 


150 


PRMX 


160 


PRMX 


170 


PRMX 


180 


PRMX 


190 


PRMX 


200 


PRMX 


210 


PRMX 


220 


PRMX 


230 


PRMX 


240 


PRMX 


250 


PRMX 


260 


PRMX 


270 


PRMX 


280 


PRMX 


290 


PRMX 


300 


PRMX 


310 


PRMX 


320 


PRMX 


330 


PRMX 


340 


PRMX 


350 


PRMX 


360 


PRMX 


370 


PRMX 


380 


PRMX 


390 


PRMX 


400 


PRMX 


410 


PRMX 


420 


PRMX 


430 


PRMX 


440 


PRMX 


450 


PRMX 


460 


PRMX 


470 


PRMX 


480 


PRMX 


490 


PRMX 


500 


PRMX 


510 


PRMX 


520 


PRMX 


530 



SI 

•o 



II FOR SUBROUTINE FOR ORTHOGONAL ROTATION (VARIMAX) 

*ONE WORD INTEGERS 

C SUBROUTINE FOR ORTHOGONAL ROTATION (VARIMAX) 

SUBROUTINE VARMX 

COMMON ICR, ICP, I PR, ITW, ITL, IT2, I PROS , N, NF,C ASES , NPAGE, I 
1 1 COM, I ROT, NFRT, KX( 1 ) , MX ( 20 ) ,MX ( 1 5 ] , TRC,FLVB!4) , KNN 

COMMON TITLE! 18),VNAME( 30) ,SUMY( 30 ) , SDf 30 ) ,H ( 3 0) , A (30 , 1 

COMMON B!10,10) 

101 FORMAT! 10X,18A4,5X,3HJ0B,I7,5X,4HPAGE, 16) 

102 FORMAT! 26X13, 1X2F15. 3) 

103 F0RMAT(//42X,37HN0RMAL VARIMAX CRITERION 1 NORMAL I ZED) // 
1X9HCRITER10N5XL0HDIFFERENCE5X18HEPSIL0N CRI TER ION= , F14. 

C INITIALIZE VARIABLES. 
PREV=C. 
IF (NFRT) 50,50,52 

50 IF INF-10) 51,51,53 

51 NFRT = NF 
GO TO 54 

52 IF (NFRT-10) 54,54,53 

53 NFRT = 10 

54 EPS=0. 00116 

C FORM IDENTITY MATRIX FOR TRANSFORMATION 

DO 3 1=1, NFRT 

Bl I , I 1 = 1.0 

DO 3 J=1,NFRT 

IFII-J) 1,3,1 
1 B( I, J) =0. 
3 CONTINUE 

LL = NFRT - 1 

NV = 

FN=N 

CONS = .7071068 
C NORMALIZE INPUT MATRIX 



DO 5 I 
H(I)=0, 
DO 4 J 



1,N 



= l.NFRT 



4 H( I ) = H( I) + AII,J)*A! I, J) 
H(I) = SQRTIH(D) 

DO 5 J = l.NFRT 

5 All, J) = All, J) / Htl) 
NPAGE = NPAGE + 1 
CALL FMAT! IPR, ITW) 
IF(IPR) 501,501,6 

501 WRITEIITW.lOl) T I TLE, I PROB, NPAGE 

6 WRITE(ITW,103)EPS 

; COMPUTE VARIANCE OF SQUARES FOR TO TEST CONVERGENCE. 
61 TV = 0. 
NV=NV+1 
DO 8 J= l.NFRT 
SA = 0. 
SA2 =0. 
00 7 1=1, N 

ECCH = Ad, J) * Al I, J) 
SA = SA + ECCH 

7 SA2 = SA2 + ECCH * ECCH 
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V = (FN*SA2-SA*SA)/(FN*FN) 

8 TV = TV + V 
DIFFR = TV - PREV 
PREV = TV 

WRITEIITW,102) NV, TV, DIFFR 
IFINV - 5019,999,999 
IS THE VARIANCE ON THIS CYCLE EQ 

9 IFUBSf DIFFR)-. 000001) 999,999,1 
BEGIN NEXT ITERATION CYCLE 

13 DO 40 J=1,LL 
II=J+1 

DO 40 K=!I,NFRT 
COMPUTE THE NUMERATOR AND DENOMI 



NATOR OF THE TANGENT OF THETA. 





AA=0.0 




BB=0.0 




CC=0.0 




DD=0.0 




00 15 I = 1,N 




XX=A(I, J) 




YY=A! I,K! 




UU = (XX + YY) * (XX - Y' 




VV = 2.0 * XX * YY 




CC = CC + ( UU + VV)*(UU 




OD = DD + UU * VV 




AA = AA + UU 


15 


BB = BB + VV 



VV) 



T = 2.0 * (DD - AA * B8/FN) 
Z = CC - (AA * AA -BB*BB)/FN 
IFIT - Z)18,16,22 

16 IF! (T+Z1-EPS) 40,17,17 

17 COST = .9807853 
SINT = .1950903 

THE SIN AND COSINE OF 11 DEGREES, 15 MINUTES ( 45/4 DEGREES ) 
GO TO 26 

18 TAN4T = ABSIT/Z) 
IFITAN4T-EPS) 20,19,19 

19 C0S4T=1.0/SQRT(1.0+TAN4T**2) 
SIN4T=TAN4T*C0S4T 
GO TO 25 

20 IF.IZ) 21,40,40 

21 SINP=C0NS 
COSP=CONS 
GO TO 31 

IF THE NUMERATOR IS MORE THAN THE DENOMI NATOR , REVERSE THE TWO. 

22 CTN4T = ABSIZ/T) 
IF(CTN4T - EPS) 24,23,23 

COMPUTE SUCCESIVELY COS 2T.SIN 2T, COS T, SIN T. 

23 SIN4T = 1.0/SQRT! 1.0+CTN4T**2) 
C0S4T = CTN4T*SIN4T 
GO TO 2 5 

24 C0S4T = 0.0 
SIN4T = 1.0 

25 C0S2T = CONS* SORT! 1. + C0S4T) 
SIN2T=SIN4T/(2.0*COS2T) 
COST = CONS * SQRTI1. t C0S2T) 



VRMX 550 
VRMX 560 
VRMX 570 
VRMX 580 
VRMX 590 
VRMX 600 

UAL(APPROXIMATELY) TO LAST CYCLES'VRMX 610 

VRMX 620 
VRMX 630 
VRMX 640 
VRMX 650 
VRMX 660 
VRMX 670 
VRMX 680 
VRMX 690 
VRMX 700 
VRMX 710 
VRMX 720 
VRMX 730 
VRMX 740 
VRMX 750 
VRMX 760 
VRMX 770 
VRMX 780 
VRMX 790 
VRMX 800 
VRMX 310 
VRMX 820 
VRMX 830 
VRMX 840 
VRMX 850 
VRMX 860 
VRMX 870 
VRMX 880 
VRMX 890 
VRMX 900 
VRMX 910 
VRMX 920 
VRMX 930 
VRMX 940 
VRMX 950 
VRMX 960 
VRMX 970 
VRMX 980 
VRMX 990 
VRMX1000 
VRMX1010 
VRMX1020 
VRMX1030 
VRMX1040 
VRMX1050 
VRMX1060 
VRMX1070 
VRMX1080 
VRMX1090 



00 

o 



SUBTRACT 45 DEGREES FROM THE ANGLE. 



SINT=SIN2T/(2.0*C0ST) 

26 IF(Z) 28,28,27 

27 COSP=COST 

SINP=SINT 
GO TO 29 
IF DENOMINATOR IS NEGATIVE, 

28 COSP = CONS * (COST + SINT) 
SINP = ABSICONS * (COST - SINT)) 

29 IF(T) 30,30,31 

IF NUMERATOR WAS NEGATIVE, SUBTRACT 90 DEGREES FROM THE ANGLE. 

30 SINP=-SINP 

MULTIPLY THE TWO COLUMNS TO BE ROTATED BY THE MATRIX OF SINES AND 
COSINES 

31 DO 32 1=1, N 

AIJ = A(I,J) * COSP ♦ A(I,K) * SINP 
AIK = -AU,J)*SINP + A(I,K)*COSP 
AU,JI=AIJ 

32 AU,K)=AIK 

ROTATE THE CORRESPONDING COLUMNS OF THE IDENTITY MATRIX TO OBTAIN 
THE TRANSFORMATION MATRIX. 

DO 33 T=1,NFRT 

COST = BU,J! * COSP *... .8 (..!-, K1-* SINP 

COSP - 8(1, J) * SINP 



SINT = B(I,K) 
B(I,J) = COST 
33 B(I,K) = SINT 
40 CONTINUE 
GO TO 61 
999 KX( 1) =0 

DO 2 1=1, N 
DO 2 J=1,NFRT 
2 AU,J)=AU,J)*HU) 
RETURN 
END 
// DUP 
♦STORE WS UA VARMX 



VRMX1100 // FOR FIND EIGENVECTORS OF TRIDIAGONAL MATRIX VCTR 

VRMX1110 *ONE WORD INTEGERS VCTR 10 

VRMX1120 C FIND THE EIGENVECTORS OF THE TRIDIAGONAL MATRIX BY VCTR 20 

VRKX1130 C THE METHOD OF J. H. WILKINSON VCTR 30 

VRMX1140 SUBROUTINE VECTR VCTR 40 

VRMX1150 DIMENSION CONS( 30 ) , VECT ( 30) VCTR 50 
VRMX1160 COMMON ICR, ICP, I PR, ITW, IT 1 , IT2 , I PR08,N, NF , CASES, NPAGE, I NMD, ISCR , VCTR 60 

VRMX1170 1IC0M,IR0T,NFRT,KX(1),MX(20),NX(15),TRC,FLVB(4>,KNN VCTR 70 

VRMX1180 COMMON TI TLE( 18 ) , VNAMEI 30 ) , SUMYI 30 ) , SD( 301 , X ( 30) ,R ( 30, 30) VCTR 80 

VRMX1190 COMMON ALPHA( 30 ) , BETA! 30) , XX VCTR 90 

VRMX1200 DO 500 K=1,NF VCTR 100 

VRMX1210 XX = X(K) VCTR 110 

VRMX1220 C INITIALIZE RIGHT SIDE OF EQUATIONS TO BE SOLVED TO ONES. VCTR 120 

VRMX1230 DO 1 1=1, N VCTR 130 

VRMX1240 1 CONS! I) = 1.0 VCTR 140 

VRMX1250 OLDH = 1.0 VCTR 150 

VRMX1260 DO 100 UK = 1,10 VCTR 160 

VRMX1270 CALL COVEC (CONS , VECT) VCTR 170 

VRMX1280 H = 0.0 VCTR 180 

VRMX1290 DO 2 1=1, N VCTR 190 

VRMX1300 IF(ABSIH) - ABSI VFC T( I I I I 1 1 . 2- 2 VC T R 200 

VRMX1310- 11 H = VECT(I) - VCTR 210 

VRMX1320 2 CONTINUE VCTR 220 

VRMX1330 00 4 1=1, N VCTR 230 

VRMX1340 IF(ABS(CONS( IWOLDH - VECT(I)/H) - 5 .OE-2 I 4 ,45 , 45 VCTR 240 

VRMX1350 4 CONTINUE VCTR 250 

VRMX1360 GO TO 200 VCTR 260 

VRMX1370 C IF RESULTS DO NOT CONVERGE, SET RIGHT-HAND SIDE TO LAST APPROX. VCTR 270 

VRMX1380 C AND LOOP VCTR 280 

VRMX1390 45 OLDH = H VCTR 290 

VRKX1400 DO 100 J=1,N VCTR 300 

VRMX1410 100 CONS(J) = VECTU) VCTR 310 

VRMX1420 C ONCE APPROX. SOLUTION HAS BEEN FOUND, REFINE IT TO FIVE PLACES. VCTR 320 

VRMX1430 200 CONS! 1)=C0NS( 1 1-VEC T( 1 >* (ALPHA! 11-XX) - VECT ( 2 ) *BETA ( 1 ) VCTR 330 

VRMX1440 DO 201 1=2, N VCTR 340 

201 CONS(I) = CONS(I) - VECT(I-l) * BETA(I-l) - VECTU + 1) * BETAUVCTR 350 

1) - VECT(I) * (ALPHA! !)-XX) VCTR 360 

CALL CQVECICONS.CONS) VCTR 370 

H = 0.0 VCTR 380 

DO 212 1=1, N VCTR 390 

VECTU) = VECTU) + CONS! I) VCTR 400 

IF(ABS(H)-ABS(VECT! I) 1)211,212,212 VCTR 410 

211 H = VFCT(I) VCTR 420 

212 CONTINUE VCTR 430 
C REDUCE MAGNITUDE OF EIGENVECTOR TO PREVENT POSSIBLE OVERFLOWS. VCTR 440 

DO 3 1=1, N VCTR 450 

3 CONSdl = VECTU) / H VCTR 460 

C TRANSFORM EIGENVECTOR TO CORRESPONDING VECTOR OF ORIGINAL MATRIX VCTR 470 

C AND NORMALIZE VCTR 480 

H = 0.0 VCTR 490 

DO 206 1=1, N VCTR 500 

VECT! I) = 0.0 VCTP 510 

DO 205 J=1,N VCTR 520 

205 VECTU) = VECTU) + CONS (J ) *R( I , J ) VCTR 530 

206 H = M ♦ VECTU)*VECT(I ) VCTR 540 



H = SQRT(H) 

00 210 1=1, N 
210 VECT1I) = VECTU) / H 

WRITE !5'K> [VECT! lit 1=1, N) 
500 CONTINUE 

DO 600 K=1,NF 

READ(5'K)(RU,K>,I=1,N> 
600 CONTINUE 

RETURN 

END 
// OUP 
*STORE WS UA VECTR 
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// FOR SOLVE SIMULTANEOUS TR1DIAG0NAL EQUATIONS 
*ONE HORO INTEGERS 

PERFORM A SINGLE ITERATION OF WILKINSONS METHOD 

SUBROUTINE COVEC(CONS,VECT) 

SOLVES THE SYSTEM OF EQUATIONS WHOSE GENERAL FORM I S- 

BETA(I)*X(I-1) +(ALPHA(I>-XX)*X(I) + BETA I I ) *X ( I + 1 > = CONS(I) 

FOR X(l - N) , WHERE BETA (0 >=BET A (N+l >=0. AND XX IS AN EIGENVALUE 

OF THE TRIDIAGONAL MATRIX DETERMINED BY THE ALPHAS AND BETAS. 

DIMENSION CONS(30),VECT(3O) 

DIMENSION U(29),V!29),W!29) 

COMMON ICR,ICP,IPR,ITW,IT1,IT2, I PROB, N , NF ,C ASES , NPAGE , I NMD, I SCR , 
1ICOM,IROT,NFRT,KX(1),MX(20),NX( t 5) , TRC, FLVB ( 4) ,KNN 

COMMON TITLE(18),VNAME(301,SUMY( 30) , SDl 30 ) ,DATA I 30 ) ,R( 30, 30 I 

COMMON ALPHA(30),BETA(30),XX 

C = CONS(l) 

P = ALPHA(l) - XX 

Q = BETA(l) 

I = 2 

10 PP = BETAU-U 
QQ = ALPHA! I) - XX 
RR = BETA! II 
SELECT MAXIMUM COEFFICIENT OF XII) AS I TH PIVOT 

4 IF!ABS!PP)-ABS!P))2,3,3 
3 U(I-l>= CONS! ll/PP 

V!I-1)=-QQ/PP 
WII-1)=-RR/PP 
XP = P 

P = XP * VII-1) + Q 
Q = XP * W( 1-1) 
C = C - XP * U i I - 1 1 
GO TO 5 
2 UII-1)= C/P 
V(I-l) = -Q/P 
W!I-1)=0.0 
P = QQ + PP*V(I-1) 
Q = RR 

c = coNsm - pp*u(i-d 

5 I = I * 1 
IF(I - N)10,ll,12 

11 PP = BETA(N-l) 
QQ = ALPHA(N) - XX 
RR = 0.0 
GO TO 4 

12 VECTIN) = C/P 
BACK SUBSTITUTION 

14 DO 20 1=2, N 
J = N+l-I 



20 VECT1JI = 
40 RETURN 
END 

// DUP 

*STORE WS 



U(J>+V!J>*VECT(J+l! + W(J>*VECT<J«-2) 
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// FOR ROTATIONS PACKAGE FOR FACTOR ANAL/SI S 
♦ONE WORD INTEGERS 
*IOCS<CARD,1132PRINTER,DISK) 
♦NAME FCTR3 

C ROTATIONS PACKAGE FOR FACTOR ANALYSIS 

OEFINE FILE 606 I 500 , 65, U, IT1 ) 
DEFINE FILE 5( 30, 60 ,U, I T2 ) 

COMMON ICR.ICP, IPR,ITW, IT1, IT2, I PROB , N, NF,C ASES .NPAGE, I NMD, I SCR, 
1IC0M,IR0T,NFRT,KX(1) , MX I 20 > ,NCD1 , NCD2 , NCD3, I SEQ, NC ASE.NXI 10>,TRC, 
2FLVB(4),KNN 
COMMON TITLE(18),VNAME(30),SUMY( 30 ) , SD( 30 ) , X( 30) , R{ 30, 10) 
COMMON B(10 f 10),E<10 t 10),G!10) 
100 FORMAT! /2X13HJ0B COMPLETED) 

4 IFI1R0T-1) 9,5,5 

5 CALL VARMX 
CALL RFOUT 
IFUROT-2) 7,6,6 

6 CALL PROMX 
CALL RFOUT 

7 IF(ISCR)' 9,9,8 

8 CALL SCORE 

9 WRITEIITW.IOO) 
CALL EXIT 

END 
// DUP 
♦STORE WS UA FCTR3 
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// FOR MATRIX PRINT/PUNCH ROUTINE FOR ROTATION 

* ONE WORD INTEGERS 

C MATRIX PRINT/PUNCH ROUTINE FOR ROTATION 

SUBROUTINE RPRNT! B, MI D, KODE , NR, NC ) 

DIMENSION BflO.10) 

COMMON ICR.ICP.IPR, ITW, IT 1, IT2, I PROB, N,NF, CASES , NPAGE, I NMD, KX( 5) , 
1MX(20),NX(15),FLVBI5),KNN 

COMMON TITLE(1B),VNAMEI30),SUMYI 30I,SD(30) ,OATA ( 30) , R ( 30, 10) 

101 F0RMAT(5XA4,4X8F12.4I 

102 FORMAT! 3X14, 6X8F12. 4) 

103 FORMAT! I0X, 18A4 ,5X, 3HJ0B , I 7 , 5X, 4HPAGE, 16 ) 

104 FORMAT! 14, 312, 5E14. 7) 

105 FORMATI/103H READY THE PUNCH WITH BLANK CARDS AND PRESS START ON 
1HE PUNCH AND CONSOLE. TURN CONSOLE SWITCH 15 ON.) 

106 FORMAT! 1H ) 

201 F0RMATI3X ,8HVAR I ABLE , 7X,8 ( ! 4, 8X) /// ) 

327 FORMAT! /45X 32H0RTH0G0NAL TRANSFORMATION MATRIX ) 

328 FORMAT! /41X 33H0RTH0G0NAL FACTOR MATRI X 1 VAR IMAX ) 1 

329 FORMAT! /45X 50HTR ANSFORMATION TO OBLIQUE REFERENCE VECTOR STRCTR. 

330 F0RMATI/45X 41H0BLIQUE REFERENCE VECTOR STRUCTURE MATRIX ) 

331 F0RMATI/45X 44HC0RRELATI0NS AMONG OBLIQUE REFERENCE VECTORS) 

332 F0RMATI/45X 39H0BLIQUE REFERENCE VECTOR PATTERN MATRIX ) 

333 F0RMATI/45X 48HC0RR. BET. REFERENCE VECTORS AND PRIMARY FACTORS ) 

334 FORMAT! /45X 39H0BLIQUE PRIMARY FACTOR STRUCTURE MATRIX ) 

335 FORMAT! /45X 35HCDRR. AMONG OBLIQUE PRIMARY FACTORS ) 

336 F0RMATI/45X 31H0BLIQUE PRIMARY FACTOR LOADINGS) 

337 FORMAT! /45X 36HFACT0R SCORE REGRESSION COEFFICIENTS ) 
IF(MX(MID)-1)1000, 1,100 

11 = 1 

11 = 8 

ISW = MID-6 
9 IF(NC-II) 10,11,11 

10 II = NC 

11 NPAGE = NPAGE + 1 
CALL FMAT! IPR.ITW) 
IFUPR1 111,111,112 

111 WRITE(ITW,103)TITLE,IPR0B,NPAGE 

112 GO TO (21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31), ISW 

21 WRITE! ITW, 327) 
GO TO 32 

22 WRITE! ITW, 328) 
GO TO 32 

23 WRITE! ITW, 329) 
GO TO 32 

24 WRITE(ITW,330) 
GO TO 32 

25 WRITE!ITW,331) 
GO TO 32 

26 WRITE! [TW.332) 
GO TO 32 

27 WRITE! ITW, 333) 
GO TO 32 

28 WRITE! ITW, 334) 
GO TO 32 

29 WRITE!ITW,335) 
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10 


RPNT 


20 


RPNT 


30 


RPNT 


40 
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50 
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60 


RPNT 


70 


RPNT 


80 


RPNT 


90 


RPNT 


100 


RPNT 


110 


TRPNT 


120 


RPNT 


130 


RPNT 


140 


RPNT 


150 


RPNT 


160 


RPNT 


170 


1RDNT 


180 


RPNT 


190 


RPNT 


200 


RPNT 


210 


RPNT 


220 


,' 'NT 


230 


*PNT 


240 


RPNT 


250 


RPNT 


260 


RPNT 


270 


RPNT 


280 


RPNT 


290 


RPNT 


300 


RPNT 


310 


RPNT 


320 


RPNT 


330 


RPNT 


340 


RPNT 


350 


RPNT 


360 


RPNT 


370 


RPNT 


380 


RPNT 


390 


RPNT 


400 


RPNT 


410 


RPNT 


420 


RPNT 


430 


RPNT 


440 


RPNT 


450 


RPNT 


460 


RPNT 


470 


RPNT 


480 


RPNT 


490 


RPNT 


500 


RPNT 


510 


RPNT 


520 


RPNT 


530 


RPNT 


540 



00 

w 



GO TO 3 2 
30 WRITE( ITW.336) 

GO TO 32 
3L WRITE( ITH,337) 

32 WRITEdTW,201)(J,J=l,II) 
00 3 5 K=1,NR 

IFIKOOEI 34,33,34 

33 WRITE! ITH, 101) VNAME! K ) , (R ( K, J ) , J = t , I I ) 
GO TO 35 

34 WRITE!ITW,102) K, <B (K, J ) , J= 1 , 1 1 ) 

35 CONTINUE 
IFINC-II) 36,1000,36 

36 I = 1+8 

II = II +8 
GO TO 9 
PUNCH ROUTINE 
100 I = 1 
II = 5 

READ! ICR, 106) 
CALL DATSW!15,JIG) 
IF(JIG-2)151,3,3 
3 WRITE(ITW,105) 
PAUSE 

151 IF(NC-II) 152,153,153 

152 II = NC 

153 00 156 K = 1,NR 
IF(KODE) 154,154,155 

154 WRITE(ICP,104)IPROB,MID,I , K, ( R ( K, J ) , J= I , I I) 
GO TO 156 

155 WRITE(ICP,104> IPROB,MID,I , K, ( BI K , J ) , J= 1 , 1 1 ) 

156 CONTINUE 
IF(NC-II)157,158,157 

157 1 = 1-1-5 



11=11+5 

GO TO 151 
158 IF(MX(MID)-2) 
1000 RETURN 
END 
// DUP 
♦STORE WS UA 



1000,1,1000 
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RPNT 670 
RPNT 680 
RPNT 690 
RPNT 700 
RPNT 710 
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RPNT 770 
RPNT 780 
RPNT 790 
RPNT 800 
RPNT 810 
RPNT 820 
RPNT 830 
RPNT 840 
RPNT 850 
RPNT 860 
RPNT 870 
RPNT 880 
RPNT 890 
RPNT 900 
RPNT 910 
RPNT 920 
RPNT 930 
RPNT 940 



// FOR SUBROUTINE TO INVERT A MATRIX 

*ONE WORD INTEGERS 

C SUBROUTINE TO INVERT A MATRIX 

SUBROUTINE MATIN1A.N) 

DIMENSION I PI V( 10), Ad 0,10), INDEX! 10, 2), PIVOT (10) 

DO 20 J = 1,N 
20 IPIV(J) = 

DO 550 I = 1,N 



AMAX = 0.0 
DO 105 J = 
IFUPIVIJ) 



1,N 

1)60,105,60 
60 DO 100 K = 1,N 

IFCIPIV(K) - 1 180,100,740 
80 IF(ABStAMAX) - ABS ( A( J , K) ) ) 85, 100 , 100 
85 IROW = J 

ICOLM = K 

AMAX = A(J,K) 
100 CONTINUE 
105 CONTINUE 

IPIVIICOLM) = IPIV(ICOLM) <- 1 

IFIIROW - ICOLM)150,260,150 
150 DO 200 L = 1,N 

SWAP = AdROW.L) 

A( IROW, I) = AdCOLM, L> 
200 AdCOLM.L) = SWAP 
260 IN0EXII,1) = IROW 

INDEXII.2I = ICOLM 

PIVOT! I) = AdCOLM, ICOLM) 

AdCOLM, ICOLM) = 1.0 

DO 350 L = 1,N 
350 AdCOLM, L) = AdCOLM, L) / PIVOT! I) 

DO 550 LI = 1,N 

IFIL1 - ICOLM)400,550,400 
400 T = A(L1, ICOLM) 

A(L1, ICOLM) = 0.0 

00 450 L = 1,N 
450 A(L1,L) = A(Ll.L) 
550 CONTINUE 

DO 710 I = 1,N 

L .= N + 1 - I 

IFdNDEXIL.l) - INDEX(L,2))630, 710,630 
630 JROW = INDEX(L,1) 

JCOLM = INDEX!L,2I 

DO 705 K = 1,N 

SWAP = A(K.JROW) 

A(K,JROW) = A(K, JCOLM) 
705 AIK, JCOLM) = SWAP 
710 CONTINUE 
740 RETURN 

END 
// DUP 
♦STORE WS UA MATIN 



AdCOLM, L) * T 
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// FOR SUBROUTINE TO COMPUTE FACTOR SCORES 

*ONE WORD INTEGERS 

C SUBROUTINE TO COMPUTE FACTOR SCORES 

SUBROUTINE SCORE 

COMMON ICR,ICP,IPR, ITW, IT I, IT2, I PROB.N, NF .CASES, NPAGE 
1IC0M,IR0T,NFRT,KXI1),MXI20),NXI15>,TRC,FLVB(4) ,KNN 

COMMON TITLE(18),VNAME(30)tSUMY(30),SD(30),X(30) ,A(30 

COMMON 8110,10) ,Z!10) 

101 FORMAT! 10X , 18A4.5X, 3HJ0B, I 7, 5X4HPAGE, 16) 

102 FORMAT! //45X, 13HF ACTOR SCORES,// 2X 14HI DENTIFICATI 0N2 
114//) 

103 FORMAT! IXI 5, IX, I 7, 6X , 5E14. 5/20X.5E 14.5 ) 

104 FORMAT! 14,12, 5E14.7/5E14. 7) 

105 FORMAT! 1H ) 

106 FORMATI/103H READY THE PUNCH WITH BLANK CARDS AND PRE 
1HE PUNCH AND CONSOLE. TURN CONSOLE SWITCH 15 ON.) 

125-25 
C COMPUTE COMMUNALITIES 
DO 1 1=1, N 
X(I> =0. 
DO 10 J=1,NFRT 

10 X(I) = XII) - A(I,J)**2 
1 XII)=l.tX!I) 

DO 8 J=1,N 

DO 11 I=1,NFRT 

11 Z!I)=A( J,I)/X!J1 
8 WRITE(5'J) !Z1K),K=1,NFRT) 

CALL MATINIB.NFRT) 
C A-TRANSPOSE * UNIQUENESS * A, ZODED TO PHI 

DO 13 I=l,NFRT 
DO 12 J = 1,NFRT 
Z(J) = 0.0 
DO 12 K=1,N 

12 Z(J) = ZIJ) + A!K,J)*AIK,I)/XIK) 
DO 13 J=1,NFRT 

13 B(I,J) = B(I,J) + ZIJ) 
CALL MATINIB.NFRT) 

C COMPUTE FACTOR SCORE COEFFICIENTS 
DO 14 1=1, N 

READ(5'I) 1Z(L),L=1,NFRT) 
DO 14 J=1,NFRT 
All, J) =0. 
DO 14 K=1,NFRT 

14 All, J) = All, J) + B(J,K)*Z!K) 
CALL RPRNTIB, 17,0,N,NFRT) 

C COMPUTE FACTOR SCORES 

IT1 = 1 

IF! ISCR-21 302,303,302 
303 READ(ICR,105) 

CALL 0ATSW!15,JIG) 

IFUIG-21302,3,3 
3 WRITE(ITW,106) 

PAUSE 
302 LINES = 79 

11=0 
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SCOR 
SCOR 
SCOR 

,INMD,ISCR, SCOR 
SCOR 

,10) SCOR 

SCOR 
SCOR 

X,5I14,/18X5ISCOR 
SCOR 
SCOR 
SCOR 
SCOR 

SS START ON TSCOR 



SCOR 
SCOR 
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SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 

scrs 

SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 
SCOR 




10 
20 
30 
40 
50 
60 
70 
80 
90 
100 
110 
120 
130 
140 
150 
160 
170 
180 
190 
200 
210 
220 
230 
240 
250 
260 
2 70 
280 
290 
300 
310 
320 
330 
340 
350 
360 
370 
380 
390 
400 
410 
420 
430 
440 
450 
460 
470 
480 
490 
500 
510 
520 
530 
540 



18 READI606'IT1)ID, (X!I),I=1,N) 
IF1ID) 50,50,19 

19 DO 20 1=1, N 

20X11) = (XIII-SUMYil D/SD! I) 

DO 21 J=1,NFRT 

ZtJ) = 0. 

DO 21 I=1,N 
21 ZIJ) = ZIJ) * A1I,J)*X!I) 
C OUTPUT FACTOR SCORES 

IFILINES-79) 26,25,25 

25 NPAGE = NPAGE + 1 
LINES - 

CALL FMATl IPR.ITW) 
IF1IPR) 251,251,26 
251 WRITEIITW,101> T ITLE, IPROB, NPAGE 

26 IFILINES)41,42,41 

42 WRITE(ITW,102) IK,K=1,NFRT) 

41 LINES = 2+LINES + (NFRT-D/10 

II = II + 1 
30 WRITE!ITH,103) 1 1 , ID , ( Z I J) , J = l , NFRT ) 
IF! [SCR-2)18,301,18 
301 WRI TE( I CP, 1041 1 1, 12 5, I Zt J), J = 1,NFRT) 
GO TO 18 
50 RETURN 
END 
// OUP 
*STORE WS UA SCORE 
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SCOR 620 
SCOR 630 
SCOR 640 
SCOR 650 
SCOR 660 
SCOR 670 
SCOR 680 
SCOR 690 
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// FOR 

*ONE WORD INTEGERS 

SUBROUTINE FMATI IPR , ITW ! 

IF (IPR) 1,1,2 

1 WRITE(ITW,100) 
GO TO 3 

2 WRITEIITW.lOll 

3 RETURN 

100 FORMAT! 1H1) 

101 FORMAT!//' •//) 
END 

// DUP 

♦STORE NS UA FHAT 

1F0031217 
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7.0 FLOWCHARTS 
CHART DA 



4***A2********* 

* * 

* SUBROUTINE * 

* MXRAD * 
*************** 



*****B 2 ********** 



* ZERO POOLING 

* SWITCH 



***************** 



******C 2*** ******** 



READ 

« MATRIX * 

CARD 

************* 



*****E1 ********** 



* NEGATE *. 

* CARD * 

* ELEMENTS * 
***************** 



.*. NEGATIVE 

*. POOLING .* 
». .* 
*- .* 
*NO 



*****E2* ********* 



.X* STORE * 

* AND CUMULATE * 

* BY NO. * 
***************** 



.# 
*. 



F2 
* 

NO. 



*NO 



*****F3********** 



.X* 



SET *. 

NCASE * 

* POSITIVE * 

***************** 



X 

.*. 

A<t *. 



NEG. .*. 

*. POOLING .* 



*. .* 
*N0 



****B4*******#* 

* * 

* RETURN * 

* * 
*************** 



*****A5**** ****** 



SET 

SWITCH 



***************** 



. * 
*. 



X 
.*. 

G2 

* 

NO. 



*****G3********** 



X* SET *. 

* NCASE * 

* NEGATIVE * 
***************** 



****H2*** ****** 

* * 

* RETURN * 

* * 
*************** 
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**** A 2 ********* 

* * 

* PROGRAM * 

* COREL * 
******* ******** 



*****B2********** 

* MOVE SUM * 

* 2 TO * 

* VECTOR * 

* * 

* * 
***************** 



**C2******* 

* CALL PRNT * 

FOR CROSS 

PRODUCTS 



*********** 



*****Q2 ********** 

* RESIDUAL * 

* CROSS * 

* PRODUCTS * 



***************** 



**E2******* 
* CALL PRNT * 
♦FOR RESIDUAL * 
*CROSS PRODUCTS 



*********** 



*****F 2 ********** 

* COVAR. * 

* MATRIX * 



***************** 



**G2******* 

* CALL PRNT * 

FOR COVAR 

MATRIX 



*********** 



******H 2 *********** 

PRINT MEANS 

* AND STD. * 

DEVS. 



************* 



X 
.*. 
B3 *. 
.* PUNCH *. 
.* MEANS, *. YES 
*. STO. DEV. .*.... 
*. .* 

*. .* 
*. .* 
*NO 



*****B4********** 
* PUNCH * 



***************** 



*****C 3 ********** 

* CORREL, * 

* MATRIX * 



***************** 



**D3******* 

* CALL PRNT * 
FOR CORREL 

MATRIX 

* * 
*********** 



****E3********* 

* * 

* CALL NEXT * 

* L I NK * 

*************** 
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****B2*******«* 

* * 

* RETURN *X. 

* * 

*************n* 



****A3********* 

* 4 

* SUBROUTINE * 

* PRNT * 
*************** 



X 

.*. 

B3 *. 

COMPARE MX(MID) 

LT .* TO 1 *. GT 

...*. .*... 

*. .* 

*. .* 

*. .* 

*EQ 



******£ 3 *********** 

PRINT 

* TITLE * 

LINE X. 



*****B^* ********* 

* PUNCH * 

* MATRIX * 
.X* * 



************* 



******q 3 *********** 

PRINT 

* MATRIX * 

NAME 



***************** 



C4 *. 

.* IS *. 
.* MX(MID)=2 *. NO 
.*. .. 

*. .* 

*. .* 

*. .* 



****C5********* 

* * 
.X* RETURN * 

* * 
*************** 



*****D4 ********** 
* MID»1,2,..6 * 



************* 



******E 3 *********** 

PRINT 

* COLUMN * 

HEAD 

* * 

************* 



******p 3 ********* 44 

PRINT 

* MATRIX * 



************* 



****G 3 ********* 

* * 

* RETURN * 

* * 
*************** 



***************** 
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CHART OD 



****A2 ********* 

* * 

* PROGRAM * 

* POLY * 
*************** 



****** B2*********** 

READ I/O 

* UNITS CARD * 



************* 



******C2 *********** 

READ JOB 

* TITLE * 



************* 



******D2 *********** 

READ 

* OPTIONS * 



************* 



****** E 2 *********** 

PRINT 

* TITLE * 

AND OPTIONS 



************* 



******F 2 *********** 

READ 

* FORMAT * 



************* 



******£ l *********** 

READ OATA 

* FROM DISK * 



G2 *. 

.♦COMPARE*. 

I NMD 

TO 2 



***#**G3 *********** 
READ ALPHA, 
* BETA.C * 

. X FROM CARDS 



************* 



************* 



#*****H2 *********** 

READ SOURCES 

* DATA FROM * 

CARDS 



************* 



#***j2*** ****** 

* CALL LINK * 

* POL 2 * 
*************** 
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CHART OF 



****A3********* 

* * 

* PROGRAM t 

* P0L2 * 
*************** 



B3 *. 
.* INM2 *. 

GT *. NO 
.*. .. 



*. .* 
*. .* 
*YES 



**B$******* 

* CALL * 

POLSQ 



*********** 



C3 *. 
.* I COF *. 
•* GT *. YES 



X 

. *. 

D3 *. 

.* IDER *. 

.* GT *. YES 

*• •*.... 

*. .* 



**C4******* 

» CALL « 

PCOEF 



*********** 



**D^******* 

* CALL 4 

PDER 



*********** 



E3 *. 
.* ISCR *. 
•* GT *. YES 
.*. ... 



**E4******* 

* CALL * 

PFIT 



****F3********* 

* * 

* CALL * 

* EXIT * 

*************** 



*********** 
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CHART DH 



****A2 ********* 

* ' * 

* SUBROUTINE * 

* POLSQ * 
*************** 



*****B2 ********** 

* INIT. * 

* VARIABLES * 



***************** 



*****C 2 ********** 

* COMPUTE * 

* SOL.VCTR. * 
.X* C * 

* * 

* * 

***************** 



*****[)2 ********** 

* COMPUTE * 

* PREO.VALS. * 

* YA * 



***************** 



*****E2 ********** 

* COMPUTE * 

* VAR. * 

* CRITERION * 

* VAR2 * 

* * 
***************** 



F2 *. 
•*VAR2 LT*. 
t EPS *. YES 

•*. . . . 



*. 



X 

.*. 

G2 *. 

• MAX DEC*. 

GT N 



*. .* 
*NO 



*****H2 ********** 

* COMPUTE * 

* SOL. VCTR. * 

* ALPHA * 



***************** 



***** j 2 ********** 

* COMPUTE * 

* NEXT ORDER * 

* ORTH.POLY * 

* * 

* * 
***************** 



******G 3* ********** 
PRINT 
* SOLUTION * 

• X SET 



************* 



******H3 *********** 

PUNCH ALPHA. 

* BETA.C * 

IF REQUIRED 



************* 



****J 3* ******** 

* * 

* RETURN * 

* * 
*************** 



*****B$********** 

* COMPUTE * 

* SOL.VCTR. * 

* BETA * 



***************** 



C<t 
.* DEG. 





*****C5********** 




* MOVE * 


*. NO 


* VAR1 TO * 






.* 


* * 



******D4*********** 

PRINT 

* SOL. SET * 



************* 



***************** 



*****n <j ********** 

* INCREASE * 

* DEG PARAM * 



***************** 



X 

**#* 

* * 

* C2 * 

* * 
**** 
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****A 3* ******** 

% aUBHOUTINE $ 

* PCOEF * 

*************** 



*****B3 ********** 

* INITIALIZE * 

* VARIABLES * 

* KKD - OEG+1 * 

* * 

* * 
***************** 



*****C 3 ********** 

* 11=1 * 

* (DEG. OF * 

* ORTH. POLY.) * 



***************** 



*****D 3 ********** 
* II = II+l * 



***************** 



*****E 3 ********** 

* COMPUTE * 

* ORTHOGONAL * 

* POLYNOMIAL * 

* II * 

* * 
***************** 



*****F 3**** ****** 

* COMPUTE * 

* COEFFICIENT * 



***************** 



*****G 2 ********** 

* RESET * i 

* VECTORS FOR * 

* NEXT *X. 

* COEFFICIENT * 

* * ; 
***************** 



G3 *. 
.* IS 
NO .* II=KKD 



******H 3* ********** 
PRINT 

* COEFFI- * 

CIENTS 

* * 

************* 



****J3********* 

* * 

* RETURN * 

* * 
*************** 
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CHAR'T OK 



♦♦SUBROUTINE*** 
* PFIT * 



*************** 



*****B 3*** ******* 

* INITIAL- * 

* IZATION * 



***************** 



*****C3 ********** 

* 11=1 * 

* 1 = 1 * 



***************** 



*****D 3 ********** 

* COMPUTE * 

* PREDICTED * 

* VALUES * 



***************** 



E3 *. 
.* II = *. 
.* KAJP1 *. YES 
.*.... 

*. .* 



******E4 *********** 
PRINT 
* PREDICTED * 
.X VALUES 

* * 

************* 



*****F 3 ********** 

* COMPUTE * 

* NEXT * 

* POLYNOMIAL * 



***************** 



*****G3********** 

* B = 8(11) * 

* II = Iltl * 



***************** 



****F4******##* 

* * 

* RFTURN * 

* * 
*************** 
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****A1 ********* 

* * 

* SUBROUTINE * 

* PDER * 
*************** 



*****B1 ********** 

* ILL * 

* =0 * 



***************** 



*****Cl* ********* 
* IL1=IL1+1 * 



***************** 



Dl *. 
.*ID( IL1I*. 
LT * 



02 *. 
.* 111= 
.* ICASE 



***** El ********** 

* INIT. * 

* VARIABLES * 



***************** 



*****F1 ********** 
* NN = 1 * 



***************** 



*****G1* ********* 

* DPDL= * 

* DPOLY<N,N> * 

* 11 = 1 *X. 

* * 

* * 
***************** 



***** HI* ********* 

* DERIV(N,N)= * 

* SUM(CII.I)* * 

* DPDL *X. 



***************** 



X 
. *. 

Jl *. 
* 11= 

KBJP1 



****E2* ******** 

* * 

* RETURN * 

* * 
*************** 



X 

.*• 

<► *. 

NN= *. 



*****R5********** 
* NN=NN+1 * 



***************** 



******C^ *********** 

PRINT 

* DERIVATIVES * 



************* 



*****F^* ********* 

* STORE * 

* DPQL * 



***************** 



*****G4********** 

* COMPUTE * 

* NEW DPOL * 



***************** 



*****H4* ********* 

* B=BU.I) * 

* 1 1 = 1 1-H * 



***************** 
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r| oh 



****A1********* 

* * 

* PROGRAM * 

* REGR.FCTR * 
*************** 



*****Bl********** 

* SET NPAGE * 

* TO ZERO * 



***************** 



******C1 *********** 

READ 

i* UNITS * 

CARD 



************* 



****** Dl *********** 

READ JOB 

* TITLE CARD * 



************* 



******gj *********** 
READ 
OPTION CARD * 



************* 



*f**#*Fl *********** 

PRINT TITLE 

f AND OPTION * 

CARO 

* * 

************* 



******QX *********** 

J READ VARIABLE 
+ NAME CARD * 



************* 



.♦COMPARE*. 
LT .* INMD TO 
...*. 1 



. *. 

B4 *. 

.♦COMPARE*. 

INMD 

TO 4 



. .* 

*GTEQ 



*****C 3 ********** 
* SET 1=1 * 



***************** 



X 
***** 
*DN * 
* B3* 

* * 



**** 

* * 

* E3 * 

* * 
**** 



**E3******* 

*CALL FMTRD * 

♦(FORMAT READ)* 



*********** 



**F3******* 
*CALL PRNTB * 
*WRITE FORMAT 



*********** 



G3 *. 
.* ERROR 



.* 
*. 
*. 



*. YES 
.*. .. 



******D4*********** 
WRITE ERROR 

* MESSAGE * 



************* 



****E4********* 

* * 

* CALL EXIT * 

* * 
*************** 



X 




. *. 




H3 *. 




.NCDU + l)*. 




.* =0 *. YES 








*. .* 


X 


*. .* 


***** 


*. .* 


*DN * 


*N0 


* 83* 



J3 *. 
.* 1=3 *. 
* *. YES 

.*. .. . 

*. .* 



****** 3 ********** 
* 1=1+1 * 



X 

***** 

*DN * 

* B3* 

* * 



***************** 
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****B2********* 

* * 

* MODE 1 * 

* * 
*************** 



****** Q2 *********** 



*****B3 ********** 



* INIT., * 

* CHOOSE INPUT * 

* 1,2, OR 3 * 
***************** 



******C3*********** 



****B<»********* 

* * 

* MODE 3 * 

* * 
*************** 



******C^*********** 



READ X 
(CARDS) 



************* 



MODE 2. 

* READ X * 

(DISK) 

************* 



D3 *. 
* *. 

CASE *. YES 
10 .*.... 

LT .* 
*. .* 
*. .* 
*N0 



**E3******* 

* * 

TRANSFORM 

* * 
*********** 



READ 

* MATRIX * 

(CARDS) 

************* 



****D4 ********* 

* * 

* CALL LINK * 

* COREL * 
*************** 



F3 

* 

W 



X 



*****F^* ********* 



= 

.*" 

*N0 



*....X* G3 * 



**** 

* * 

* G3 * 

* * 
**** 



X 
.*. 



PRED. 
VALUES 



***************** 



******G4*********** 



WRITE X 
ON DISK 



************* 



*****H 3 ********** 



* COMPUTE 

* SUMS AND 

* CROSS PRODS. * 
***************** 



*X. 



*****J3********** 



* DETERMINE * 

* MIN AND * 

* MAX * 
***************** 



****K3********* 

* * 

* GO TO * 

* MODE 1, * 
****2,*0R*3***« 
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CHART DP 



****A3********* 

* * 

* PROGRAM * 

* REGR2 * 
*************** 



X 
.*. 
B3 *. 
. * * 
.* 
*. IREAR 
*. GT 
*• .* 
*. .* 
*YES 



*****C3********** 



CAUL 
REGRE 



***************** 



****D3********* 

* * 

* EXIT * 

* * 
*************** 
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CHART OR 



****43********* 

* * 

* SUBROUTINE * 

* REGRE * 
*************** 



*****B 3 ********** 



* DEPENDENT * 

* VAR. TO * 

* COL. N * 
**** ************* 



*****C 3 ********** 

* * 

* COMPUTE R, * 

* R**2, STD. * 

* ERR. OF EST. * 

* AND OF MEAN * 
***************** 



*****D3 ********** 



* VMIN'VMAX * 

* =VAR = * 

* NOIN=0 * 
***************** 



*****E3********** 



***************** 



X 

.*. 

F3 *. 
. * *. 
* *. NO 
R(I ill .*... 




*. GT TOL .* 

*. .* 
*. .* 
*YES 


X 
***** 
*DS * 
* C3* 



*****G3********** 



* VAR=(RU,M> * 

* *R ( M , I ) i / * 

* RII.ll * 

***************** 



X 
***** 
*DS * 
* G3* 

* * 



LT .* 



COMPARE 

VAR TO 

*. .* 



X 

***** 

*DS * 

* C3* 

* * 



VAR GT 
*. VAMX 
*. .* 

*. .* 
*YES 



X 

***** 

*DS * 

* B3* 

* * 



X 

***** 

*OS * 

* C3* 

* * 
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CHART OS 



*****B3********** 

* VMAX - VAR * 

* NMAX « I * 



***************** 



X. 

X 

.*. 
C3 *. 
.* IS *. 
.* I = N-l *. YES 

*. .* 

*. .* X 

*. .* ***** 

*. .* *DT * 

*NO * Bl* 

* * 



*****0 3 ********** 
* I - I + 1 * 



***************** 



X 
***** 
*DR * 
* F3* 

* * 



*****G3********** 

* COMPUTE * 

* COEFFICIENTS * 

* AND THEIR * 

* STD. ERROR * 

* * 
***************** 



X 
.*. 

H3 *. 

*. .* 

*. .* 

*• .* 

*YES 



*****J3********** 

* VHIN = VAR * 

* NMIN = I * 
..* * 



***************** 
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*****B1 ********** 

* COMPUTE * 

* PARTIAL * 

* CORREL * 



***************** 



*****C1 ********** 

* COMPUTE * 

* CONSTANT * 

* TERM * 



***************** 



Dl *. 
.* PRINT *. 

REGR *. NO 
.*... 
.* 
*. .* 
*. .* 
*YES 



******E1*********** 
PRINT 



************* 



Fl *. 
.* PREO. *. 
.* VALUES *. NO 
• .*. • • 



.* 
*. .* 
*YES 



******G1*********** 

PRINT 

* PREO. * 

VALUES 

* * 

************* 



X 

. *. 

B3 *. 

.* IS *. 

* VAR. K TO *. NO 

BE REMOVED .*. .. 



*. 



*****C3********** 

* K = NMIN * 

* NOENT =0 * 



***************** 



B* *. 

.* IS *. 

.* VARK TOBE *. NO 

•X*. ENTERED .*... 

*. .* 

*• .* 

*. .* 

*YES 



*****C *********** 

* K = NMAX * 

* NOENT = K * 



***************** 



****B5********* 

* * 
•X* RETURN * 

* * 
*************** 



*****D 3 ********** 

* REARRANGE * 

* INVERSE * 



***************** 



E3 *. 
.* PDS. *. 
.* MEAN SO. *. NO 



.* 
. .* 

*YES 



X 

***** 

*0R * 

* C3* 

* * 



****E4********* 

* * 
.X* RETURN * 

* * 
*************** 
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****A2********* 

* ' * 

* PROGRAM * 

* ANOVA * 
********* ****** 



******B 2 *********** 

READ I/O 

* UNITS * 

CARO 



************* 



******C2 *********** 

READ JOB 

* TITLE * 

CARD 



************* 



******D2 *********** 

READ 

* OPTION * 

CARD 



************* 



******(= 2 *********** 

PRINT TITLE 

* AND * 

OPTION 

* CARD * 

************* 



******p 2 *********** 
**** READ 

* * * DATA * 

* F2 *....X 

* * * * 
**** 

************* 



G2 *. 
.* INDI *. 
.* LT *. YESS 
*. .* 

*. .* 

*. .* 



****G3********* 

* * 

* CALL * 

* LINK * 
****(ANOV2I**** 



*NO 



*****H 2 ********** 

* COMPUTE * 

* STORAGE * 

* NO. IS * 



***************** 



X 

-*. 

J2 *. 

.* TRANS *. 

► FORM *. YES 



**J3******* 

* CALL * 

TRAN 



*********** 



B4 *. 
* IS LT *. 

1500 *. NO 



*****C^#** ******* 

* STORE * 

* DATA * 

* IN CORE * 



***************** 



*****B5** ******** 

* IS = * 

* IS-1500 * 
.X* * 

* * 

* * 
***************** 



******C 5 *********** 

WRITE 

* DATA * 

ON DISK 



************* 



.X.. 
X 

**** 



101 



****A3********* 

* * 

* SUBROUTINE * 

* srn«E * 
*************** 



B3 *. 
.* IS *. 
.♦IS LT 1500 *. NO 



*****84* ********* 
* IST=IS-1501 * 



*****C3********** 

* STORE DATUM * 

* AT LOCATION * 

* X(IS) * 



***************** 



******C4* ********** 

STORE DATUM 

* ON DISK AT * 

Lnc. 1ST 



***************** 



************* 



****D3 ********* 

* * 

* RETURN * 

* * 
*************** 



****E3********* 

* * 

* SUBROUTINE * 

* GET * 

*************** 



F3 *. 

* IS LT 
1500 



*****F 4** ******** 

* IST-IS * 

* -1500 * 
.X* * 



*****G 3 ********** 

* GET DATA * 

* FROM * 

* CORE * 



***************** 



******G4*********** 

GET DATA 

* FROM * 

DISK 



***************** 



****H 3* ******** 

* * 

* RETURN * 

* * 
*************** 



************* 
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ART 



****A3##******* 

* * 

* PROGRAM * 

* AN0V2 * 
*************** 



**83******* 
* CALL * 

* SDOP 



*********** 



**C3******* 
* CALL * 

* MNSQ 



*********** 



**[)3******* 
* CALL * 

* REPRT 



*********** 



****E 3* ******** 

* * 

* CALL EXIT * 

* * 
*************** 
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CHART EB 



****A 3* ******** 

* * 

* SUBROUTINE * 

* SDOP * 
*************** 



*****A4********** 

* NFPI = NO. * 

* OF FACTORS * 

* +1 * 



***************** 



**** 

* ; * 

* B3 * 

* 4 
**** 



B3 *. 
.* K = *. 
.* NFPI *■ YES 

.X*. .*.... 



Gl *. 

. * IS- * . 
.* MAX STORE 
*. NO. 



*****G2 ********** 
* K=K+1 * 



***************** 



*****H1* ********* 

* INCREMENT * 

* IS AND * 

* ISPM * 

* * 

* * 
******** 4******** 



*. .* 
*NO 



*****C3 ********** 

* NN = NXIK) * 

* IS = 1 * 

* ISPM =1 * 



***************** 



*****D3********** 

* SUMX =0 * 

* IN = 1 * 



***************** 



E3 *. 
.*IN = NN*. 



■ ****B4********* 

* * 
.X* RETURN * 

* * 
*************** 



*****C4*** ******* 

* NN= NO. OF * 

* LEVELS * 

* IS=STORE NO. * 

* TSPM=STORE NO * 

* * 
***************** 



**F3******* 
* SET DATUM * 
* FROM LOCA- * 
* TION IS 



*********** 



*****G 3 ********** 

* ADD DATUM * 

* TO CUM. * 

* SUMX * 



***************** 



*****H3 ********** 

* INCREMENT * 

* STORE NO. * 

* IS * 

* * 

* * 
***************** 



*****J 3*** ******* 
* IN - IN + 1 * 



***************** 



**E5******* 

* STORE * 

* SUMX AT 
.X* STORE NO. 

* IS 

* * 
*********** 



*****F5********** 
* IN = 1 * 



***************** 
**** 



**** 

* * 

* Gl *X. 

* * 
**** 



* 55 *.. 

ft * 

**** 



G5 
.*IN 



*****H5* ********* 

* FORM DEVIATES * 

* AT LOC. ISPM * 

* NN*X(ISPM1- * 

* SUMX * 

* * 
***************** 



*****J5********** 

* INCREMENT * 

* STORE NO. * 

* IS * 



***************** 



*****K<5********** 
* IN=IN+1 * 



***************** 
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****A3********* 

* * 

* SUBROUTINE » 

* MNSQ * 
*************** 



*****[} 3* ********* 



* CLEAR SUMMARY * 

* VECTORS * 

* SMQR, NO IV * 
***************** 



*****£ 3* 4******** 



* IA=IB=IC=ID=1 * 

* 1=0 * 



***************** 



*****03 ********** 



***************** 



*****D ************ 

* * 
*NA, NB, NC, ND * 

* ARE THE NO. * 

* OF LEVELS + 1 * 

* IN EA. FACTOR * 
***************** 



*****F1*** ******* 

* * 

* * 

* K - 15 * 

* * 

***************** 



*****Gi* ********* 

* * 

* GET DATA * 

* FROM DISK * 

* OR CORE * 
***************** 



j*****Hl ********** 

* * 

* COMPUTE * 

* SUMS OF SQS. * 
f AND DIVISOR * 
*SMQR(K> ,NDIV{K)* 
***************** 



X 
***** 
*EC * 
* 03* 

* * 



X 


***** 


*6D * 


* B3* 


* * 



*****F3********** 

* * 

* IA = IA * 1 * 

* * 

* * 

***************** 



X 



G3 
.* * 

IB LT NB 

"*. .* 
*. .* 

*YES 



*. NO 



X 
***** 
*EE * 
* H2* 

* * 



***** 

*EE * 

* 81* 

* * 



X 
.*. 



*****J<**** ******* 

* * 

.X* K = 11 * 

* * 

***************** 



X 
***** 

*EC * 

* Fl* 

* * 
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*****B3********** 

* * 

* * 

* 14 = 1 * 

* * 

* * 
***************** 



C3 



*****C 4*** ******* 



». IB IT NB 
*. 

*. .* 

*. •* 
♦YES 



*****D 3* ********* 



IB = IB t 1 



***************** 



***************** 



X 

***** 

*EE * 

* B3* 

* * 



E3 



*. 



.» *. NO 

*. IC LT NC .*... 
*. .* 

*. .* 

*. .* 
*YES 



*****F 2 ********** 



***************** 



X 
***** 
*EC * 
* Fl* 

* * 



F3 

* 


X 

.* 


*. 


ID 


LT 


NO 


*. 
* 


. .** 
*YES 



E4 *. 

.* * 

ID LT ND 

**- .* 

*. ,* 
*YES 



*****F4 ********** 



************;***** 



*****G3********** 



X 

***** 

*EC * 

* Fl* 

* * 



*****(- 5* ********* 



***************** 



X 
***** 

*E * 
* * 

* * 



***************** 



X 
***** 

*EC * 

* Fl* 

* * 
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I* 



IB LT 
NO 



»i***Cl********** 

* * 

* * 
*, K = 12 * 

* * 
*. * 
*+*************** 



X 
***** 

♦ EC * 

* Fl* 

* * 



*****8 2 ********** 



***************** 



X 
***** 
*EC * 
* Fl* 

* * 



*****0 2 ********** 



***************** 



X 
***** 

♦ EC * 

♦ Fl* 
* * 



.* *. NO 

*. IC LT NC .*... 

*. .* 

*. .* 

*. .* 
♦YES 



*****C 3* ********* 



IC = IC + 1 



***************** 



X 

.*. 

03 *. 
.* *• 

NO .* *. 

...*. ID LT ND .* 
*. .* 

*. .* 

*. .* 
*YES 



*****B4*** ******* 



***************** 



IS 
*.!0 LT ND 



****Ci********* 

* * 

* RETURN * 

* * 
*************** 



*****E 3 ********** 
* * 



*****D^ ********** 



ID ■= ID ♦ 1 
K = * 



***************** 



X 

***** 

*EC * 

* Fl* 

* * 



***************** 



X 

***** 

*EC * 

* Fl* 

* * 



***** j i********** 



***************** 



X 

***** 

*EC * 

* Fl* 

* 4 



.*. 
H2 *. 
.* *. 

.* *. NO 

*. IC LT .*... 

*. NC .* 

*. .* 

*. .* 
*YES 



J2 



X 
.*. 



*. 



NO .* *. 

...*. ID LT 

*. ND 

*. .* 

*. .* 
*YES 



*****K 2 ********** 



ID LT 

*. ND .* 

*. .* 

*. .* 
*YES 



*****j 3* ********* 



*****H 4*** ******* 



***************** 



***************** 



X 

***** 

*EC * 

* Fl* 

* * 



X 

***** 

*EC * 

* Fl* 

* * 



***************** 



X 
***** 
*EC * 
* Fl* 

* * 
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CHART EF 



****A2********* 

* * 

* SUBROUTINE * 

* REPRT * 
********* ****** 



*****B2 ********** 

* GENERATE OEGS * 

* OF FREEDOM * 

* VECTOR * 



***************** 



*****C 2 ********** 

* COMPUTE SUM * 

* OF SQUARES * 

* DIVISOR * 



***************** 



*****D2 ********** 

* INITIALIZE * 

* COUNTERS * 



***************** 



*****£ 2 ********** 

* COMPUTE * 

* TOTAL SUM * 

* OF SOUARES * 



***************** 



******F2 *********** 

REAO COM- 

» PONENT * 

LINE- 

* CARD * 

************* 



*****G2 ********** 

* SMSQ =0 * 

* NDFI =0 * 

* SMSOM =0 * 



********** ******* 



*****H? ********** 

* ADD COMPON- * 

* ENTS TD SMSQ, * 

* NDFI.SMQM, * 
*FROM LINE CARD * 

* * 
***************** 



.* IS *. 
NO .* INDI GT *. 

*. .* 

*. .* 
*. .* 
*YES 



****** £4*********** 

PRINT TITLE 

* AND COLUMN * 

HEAD 



************* 



* *****D4*********** 

PRINT 

* LINE * 

COMPON- 

* ENT * 

************* 



*****E<V ********** 

* ACCUML TOTAL * 

* AND DEGREES * 

* DF FREEDOM * 



***************** 



F«t *. 
.* IS *. 
INDI LT *. 



X 
.*. 

G<t *. 
.* NEED « 
NO .* RESIDUAL 
,..*. LINE 
*. 



******H 4* ********** 

PRINT 

* RESIDUAL * 



************* 



******J4***** ****** 

PRINT 

* TOTAL SUM * 

OF 

* SQUARES * 

************* 



****K<f********* 

* * 

* RETURN * 

* * 
*************** 
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CHART EG 



****A3********* 

* PROGRAM * 

* FCTR1 * 
*************** 



. *NCASE=6*. 



*. .* 
*. .* 
*YES 



**C2******* 

* CALL * 

COREL 



*********** 



D3 *. 
.♦COMPARE*. 
LT .* ICOM TO *. 
...*. 1 

*. .* 



*****D4 ********** 

* COMMUNALITY * 

* - MULT.R**2 * 
.X* * 



***************** 



*****E3 ********** 

* MAX. ROW ELE. * 

* ■ COMMUNALITY * 



***************** 



*****F3********** 

* COMPUTE * 

* TRACE * 



***************** 



**G3******* 
* CALL * 

TRior 



*********** 



**H3******* 

* CALL * 

OR 



*********** 



****J 3** ******* 

* * 

* CALL LINK * 

* (FCTR2) * 
*************** 
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****A3********* 

* * 

* SUBROUTINE * 

* INVRS * 
*************** 



*****B 3 ********** 

* K = 2 * 

* IERR=0 * 



******** ********* 



*****C 3* ********* 
*COMPUTEX(K.K)= * 
*A(K,KI**(-1 |*U * 

* IK.K1FOR KK=1 * 

* (11K-1 * 

* * 
***************** 



*****0 3 ********** 
♦COMPUTE ALPHA= * 

* ALPHA-X(I)*R * 

* (I.U)FOR 1=1 * 

* (l)K-l * 

* * 
***************** 



X 

• *. 

E3 *. 

.* IS *. 

.* ALPHA = *. YES 



*****E4********** 
* IERR - 1 * 



*. 



***************** 



****E5********* 

* * 
.X* RETURN * 

* * 
*************** 



*****P3********** 

* COMPUTE LAST * 

* COLUMN OF * 

* NEXT * 

* INVERSE * 

* * 
***************** 



*****G3********** 

* RECALCULATE * 

* PREVIOUS * 

* INVERSE * 



***************** 



*****H3 ********** 
* K=K +1 * 



***************** 



X 
• *. 



NO .* = NROW 
.. *. 



.* 
. .* 
*YES 



****RETURN***»* 



*************** 
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****A 2 ********* 

* * 

* SUBROUTINE * 

* TRIO! * 
*************** 



*##**B2 ********** 

* COMPUTE * 

* N-2 ELEM. * 

* ORTH. TRANS. * 



****A<V ********* 

* * 

* SUBROUTINE * 

* QR . * 
*************** 



*****84* ********* 

* SET INTERNAL * 

* ARRAYS * 

* FROM TRIOI * 



***************** 



*****C 2 ********** 

* APPLY THESE * 

* TO AN * 

* IDENTITY * 

* MATRIX * 

* * 
***************** 



****0 2 ********* 

* * 

* RETURN * 

* * 
*************** 



***************** 



*****C4********** 

* HANDLE 2X2 * 

* BLOCKS * 

* SEPARATELY * 



***************** 



*****04*** ******* 
•APPLY SHORTCUT * 

* SINGLE QR * 

* ITERATION * 



***************** 



*****E^********** 

* ORDER * 

* THE * 

* EIGEN VALUES * 

* * 

* * 
***************** 



****F*f********* 

* * 

* RETURN * 

* * 
*************** 
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CHART EL 



*****D2 ********** 

* NF=0 * 

* KINT-0 * 

* *X. 



*** *A 3* ******** 

* * 

* PROGRAM * 

* FCTR2 * 
*** ************ 



**B3******* 

* CALL * 

VECTR 



*********** 



******C 3 *********** 

PRINT EIGEN- 

* VECTORS * 



************* 



03 *. 

•♦COMPARE*. 

LT .* NF TO *. £Q 

...*. 2 .*... 

*. .* 



*****D4********** 

* NF=KINT * 

* KINT=0 * 
.X* * 



***************** 



***************** 



*****£ 3* ********* 
* NF=0 * 



***************** 



*****F 3 ********** 

* SUM=0 * 

* PRINT=KINT * 

* J=0 * 



Gl *. 
.* KINT *. 
.* LT OR *. NO 




*. .* 
*. .* 
*. -* 
♦YES 


X 

♦**** 

*EM * 

* 04* 

* * 



X 

***** 

♦EM * 

* B2* 

* * 



***************** 



*****G3********** 
* J = J*1 * 



***************** 



X 

.*. 

H3 *. 
.*X(J) LT*. 

OR EO 
ZERO 



X 
***** 
*EM * 
* B3* 

* * 



. * 



J3 *. 

. NF OR LT*. 

EQ TO 

ZERO 



*****H4* ********* 
* NF=J-1 * 



***************** 



******J4***** ****** 

PRINT 

* EIGEN VALUES * 



************* 



* Gl * 

* * 
**** 



X 

***** 

*FM * 

* G3* 

* * 
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ch|rt 



B2 *. 


B3 *. 


.* IS *. 


.* IS *. 


.* X(JILTl *. NO 


.* NF LT J *. YES 


*. .*... 


*. .*... 


*. .* 


*. .* 


*. .* 


*. .* 


*. .* 


*. .* 


*YES 


*NO 


**** 




* * 




* C2 *... 




* * 




**** 





*****C 2 ********** 
* NF = J-l * 



***************** 



*****C 3**** ****** 

* COMP. CUM. * 

* PERCENT OF * 

* TRACE * 



***************** 



X 

***** 

*EL * 

* J4* 

* * 



3* 1 ** 



*****Q3*?********* 

* COMP. JTH * 

* FACTOR * 



***************** 



•YIJIGT OR EQ*. 

*. PINT 



*****D5********** 

* Y(J)=CUM. * 

* PERCENT OF * 

* TRACE * 



***************** 









X 














.*. 














E<i * 








**** 






* IS 


* 






* * 


NO 


* 


J = N 




* 




* C2 *X. 


...» 










* 



X 

***** 

*EL * 

* S3* 

* * 



•ROTATION*. 

NO .* REQUIRED *. YES 

...*. .*.... 

*. .* 

*. .* 



****H2 ********* 

* * 

* CALL * 

* EXIT * 
*************** 



****H4********* 

* * 

* CALL LINK * 

* (FCTR3) * 
*************** 
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tHART EN 



****A1 ********* 

* * 

* SUBROUTINE * 

* VECTR * 
*************** 



*****B1* ********* 

* INIT.RHS * 

* OF EQUAT. * 

* TO ONES * 



****A3 ********* 

* * 

* SUBROUTINE * 

* COVEC * 

*************** 



*****B 3* ********* 

* INITIALIZE * 



***************** 



*****Cl ********** 

* GET * 

* APPROX. * 

* SOLUTION * 



***************** 



*****C3 ********** 

* SOLVE * 

* SIM. TRIDI * 

* EQUATIONS * 



***************** 



*****01* ********* 

* REFINE * 

* SOLUTION * 



***************** 



***** El ********** 

* NORMALIZE * 

* EIGENVECTOR * 



***************** 



****FL ********* 

* * 

* RETURN * 

* * 
*************** 



***************** 



****D 3 ********* 

* * 

* RETURN * 

* * 
*************** 
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CHARf EP 



****A 3 ********* 

* * 

* PROGRAM * 

* FCTR3 * 
*************** 



B3 *. 
ROT. CNST.. 
.* LT 1 *. YES 
*. .*.... 

*. .* 

*. .* 
*. .* 
*NO 



**C3******* 
* CALL * 

VARMX 



*********** 



**D3******* 
* CALL * 

RFOUT 



*********** 



X 
.*. 
E3 *. 
.* ROT. 1 
.* CONST. 
*. LT 2 
*. 



**E4#****** 

* CALL * 

PROMX 



*********** 



**F2******* 

* CALL * 

SCORE 



********* ** 



X 

.*. 

F3 *. 

.* ISCR. *. 

= *. 

.*X. 



*. 



.* 
. .* 
*YES 



**F4******* 

► CALL * 

RFOUT 



*********** 



****G 3 ********* 

* * 

* CALL EXIT * 

* * 
*************** 
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****A2 ********* 

* * 

* SUBROUTINE * 

* RFOUT * 
*************** 



X 
.*. 

B2 *. 
.* IS * 
.* KX(1I=0 



«*****C2 *********** 

PRINT 

* MATRIX * 

7 



************* 



******02 *********** 

PRINT 

* MATRIX * 

8 



************* 



*****E2 ********** 
» SET B TO * 

* IDENTITY * 

* MATRIX * 



***************** 



****F z ********* 

* * 
» RETURN * 

* * 
*************** 



******A 3 *********** 
PRINT 
* MATRIX * 
.X 9 



************* 



******B3*********** 

PRINT 

* MATRIX * 

11 



************* 



******C3 *********** 

PRINT 

* MATRIX * 

10 



************* 



**Q3******* 

* INVERT * 

MATRtX 

10 



*********** 



*****E3********** 

* COMPUTE * 

* PATTERN * 

* MATRIX (12) * 



***************** 



******F3*********** 

PRINT 

* PATTERN * 

MATRIX 



************* 



*****G 3 ********** 
* COMPUTE * 
« MATRIX 13 * 



**** ************* 



******H 3***** ****** 

PRINT 

* MATRIX * 

13 

* * 

************* 



*****J3********** 

* COMPUTE * 
» MATRIX * 

* 15 * 

* * 

* * 
***************** 



******B4*********** 

PRINT 

* MATRIX * 

15 



************* 



*****C4********** 

* COMPUTE * 

* MATRIX 14 * 



***************** 



******D4*********** 

PRINT 

* MATRIX * 

14 

* * 

************* 



*****E4********** 

* COMPUTE * 

* MATRIX * 

* 16 * 



***************** 



******f4*********** 

PRINT 

* MATRtX * 

16 



************* 



****3 4* ******** 

* * 

* RETURN * 

* * 
*************** 
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CHART ES 



****A2********* 

* * 

* SUBROUTINE * 

* PROMX * 
*************** 



*****B2 ********** 
* B=A**<TH) * 



***************** 



*****C2 ********** 
* B**(-l) * 



***************** 



*****02 ********** 

* COMPUTE * 

* ROM NORM- * 

* AlIZING * 

* VECTOR, H * 

* * 
***************** 



*****E2 ********** 

* COLUMN * 

* NORMALIZING * 

* VECTOR. G * 



***************** 



*****F2 ********** 

* NORMALIZE * 

* ROHS.COLS. * 

* OF A * 

* * 

* * 
***************** 



*****G 2 ********** 
* E=A**(T+K1 * 



*****G3********** 

* K IS * 

* OBLIQUE- 
X* NE" 



NESS 
POWER 



***************** 



*****H2 ********** 

* TRANSFORM- * 

* ATION * 

* MATRIX * 

* B=B*E * 

* * 
***************** 



***** J 2 ********** 

* NORMALIZE * 

* COLS. OF * 

* B * 



***************** 



***************** 



*****B^ ********** 

* ROTATE TO * 

* REF. VCTR. * 

* STRUCTURE * 

* MATRIX * 

* * 
***************** 



*****C4********** 

* COMPUTE * 

* CORREL. * 

* E-B**(T+1) * 



***************** 



****D*f********* 

* * 

* RETURN * 

* * 
*************** 
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****A3********* 

* * 

* SUBROUTINE * 

* VARMX * 
*** ************ 



*****B3* ********* 

* INITIALIZE * 

* INTERNAL CON- * 

* STANTS AND * 

* VARIABLES * 

* * 
***************** 



*****C 3 ********** 

* INITIALIZE * 

* T MATRIX * 

* TO IDENTITY * 



***************** 



*****D3********** 

* NORMALIZE * 

* INPUT * 

* MATRIX A * 

* * 

* * 
***************** 



*****E 3* ********* 

* COMPUTE VAR- * 

* IANCE FOR * 

* EACH COLUMN * 



***************** 



*****F 3 ********** 

* COMPUTE SUM * 

* OF VARIANCES * 

* OVER ALL * 

* COLUMNS * 

* * 
***************** 



G3 *. 

.* HAVE *. 

' 50 CYCLES *. 

ELAPSED 



. .* 

*N0 



X 

-*. 

H3 *. 

.* IS *. 

* SUM=SUM *. YES 

ON PREVIOUS .». ... 
*. CYCLE .* 
*. .» 
*. .* 
*N0 



*****G4*** ******* 
* KXI1I =0 * 



***************** 



****G 5* ******** 

* * 
•X* RETURN * 

* * 
*************** 



*****J 3 ********** 

* PICK 2 COLS. * 

* FROM A FOR * 

* ROTATION * 

* (X,YI * 

* * 
***************** 



X 

***** 

*EM * 

* B2* 

* * 
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CHART EW 



**B2******* 



**** A ^* ******** 

* * 

* ROUTINE * 

* A * 
*************** 



*****B4* ********* 



* 00 ROUTINE 
* A 



*********** 



*****£ 2 ********** 
* * 



CC = SUM(UI I) 
♦*2-V< t)**2) 



***************** 



****#D2 ********** 



* um=xm**2 * 

* -. Y (t!**2 * 

* * 
***************** 



*****o ********** 



U( I)=2.» 

xm*Y(ii 



***************** 



*****0<V********** 



* T=OD-2AA* * 

* BB/N * 

* * 
*******###******* 



*****F 2 ********** 

* * 

* * 

* CTN4T=Z/T *X. 

* * 

* * 
***************** 



*****E 3 ********** 



* Z = CC- * 

* IAA**2-BB**21 * 

* /N * 
***************** 



X 

.*. 

F3 *. 

.* *. 

GT .* *. EQ 

...*. COMPARE .*... 

*. T TO .* 

*. Z .* 

*- .* 

*LT 



* AA'SUM(UU) 1 

* BB=SUH(VII) ) 



***************** 



****E4********* 

* + 

* RETURN * 

* * 
*************** 



(T+ZILT 
.00116 .* 



. .* 

*NO 



*****G1* ********* 



COS4T=0 
SIN4T-1 



***************** 



YES .* 



(CTN4T1LT 
.00116 . 



. .* 
*NO 



*****G 3 ********** 

* * 

* * 

* TAN4T=T/Z * 



***************** 



*****G4********** 



X 
***** 

EXB3 



*****H2 ********** 



* COMPUTE * 

* COS4T, SIN4T * 

* FROM CTN4T * 
***************** 



X 

***** 

*EX * 

* B3* 

* * 



TAN4T 

LT 

*. 00116. 

*. .* 

*NO 



*****j 3 ********** 



*COST=COS(PI//L>*. 
*SINT=SINIPI//6)* 



***************** 



.*. 
H4 *. 

* 

Z LT 



. .* 
*YES 



***** J 4*** ******* 



X 

***** 

*EX * 

* H3* 

* * 



X 
***** 
*EX * 
* C3* 

* * 



X 
***** 
*EX * 
* H3* 

* * 



* COMPUTE * 

* C0S4T, S1N4T * 

* FROM TAN4T * 
***************** 



SINP=C0SP 
» .7071 



***************** 



X 

***** 

*EX * 

* B3* 

* * 



X 

***** 

*EX * 

* F3* 

* * 
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*****B3********** 

* COMPUTE * 

* COS2T.SIN2T, * 

* COST.SINT * 



***************** 



C3 *. 
* IS 
Z GT 



*. 
*. 



*****C4********** 

*COSP=.707ICOST * 

* +SINT).SINP= * 

.X*.707(COST-SINTI* 



***************** 



*****D3 ********** 

* CDSP = COST * 

* SINP =- SINT * 



***************** 



E3 *. 

* IS * 

T GT 



*****E^********** 
* SINP=-SINP * 



****************** 



*****F3********** 

* ROTATE TWO * 

* COLUMNS OF * 

* MATRIX A MTH. * 

* SINE, COS. * 

* * 
***************** 



*****G 3 ********** 
♦ROTATE CORRES- * 

* PONDING COLS. * 

* OF IDENTITY * 

* MATRIX * 

* * 
***************** 



X 




. *. 




H3 *. 




.* ALL *. 




.* PAIRS *. NO 








*. .* 


X 


*. .* 


***** 


*. .* 


*ET * 


*YES 


* J3* 



*****J 3 ********** 

* INCREMENT * 

* CYCLE * 

* COUNTER * 



***************** 



X 

***** 

*ET * 

* E3* 

* * 
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CHART EY 



****C2 ********* 

* * 

* RETURN *X. 

* * 
*************** 



****A3* ******** 

* * 

* SUBROUTINE * 

* RPRNT * 
*************** 



*****B3 ********** 
* ISW=M[D-6 * 



***************** 



C3 *. 
.♦COMPARE*. 
.*MX<MIDIT01 *. GT 
. * . • • 



******D3 *********** 

PRINT 

* TITLE * 

LINE X. 



************* 



******E3*********** 

PRINT 

* MATRIX * 

NAME 

* * 

************* 



X 
.*. 
F3 *. 
.* IS *. 
.* KODE-0 *. NO 
*. .*... 

*. •* 

*. .* 
*. .* 
*YES 



*****C 4* ********* 

* PUNCH * 

* MATRIX * 
• X* * 

* * 

* * 
***************** 



X 

.*. 

D4 *. 

.* IS *. 

YES .* MX(MID>=2 



. *. 



*. 



****D 5* ******** 

* * 
.X* RETURN ♦ 

* * 
*************** 



*****E4********** 
* ISW-liZt...ll * 



***************** 



******G3*********** 

PRINT ALPHA 

* COLUMN * 

HEAD 



************* 



******G4*** ******** 

PRINT 

* NUMERIC * 

COLUMN 

* HEAD * 

************* 



******H3*********** 

PRINT 

* MATRIX * 



************* 



****j3********* 

* RETURN * 

* * 
*************** 



121 



r 



CHART EZ 



****A3********* 

* * 

* SUBROUTINE * 

* MATIN * 
*************** 



*****B3********** 

* ipivm-o * 

* 1 = 1, N * 



***************** 



***#*C 3 ********** 

* 1 = 1 * 

* AMAX=0.0 * 



***************** 



*****D3 ********** 

* FIND FIRST * 

* ELEMENT C1F * 

* IPIV THAT =1 * 

* * 

* * 
***************** 





X 












.*- 












E3 * 












* WAS 


* 








.* 


ONE 




* * 


YES 




*. 


FOUND 




.* 






*. 




X 




*• • 


* 






***** 




*. .* 








*FA * 




♦NO 








* B2* 


**** 








* * 


* 


* 








* 


* F3 

* 


* 










**** x 












-*. 












F3 *. 










. 


* IS 


* 






**** 


.* 


THERE 




*. 


NO 


* 4 


*. 


ANOTHER 






*.... 


X* J3 * 


*. 






*" 




* * 




*. 


* 






**** 



. ...X. 

X 

.*. 

G3 *. 

.* IS *. 

A(J,K)GT *. YES 
AMAX .*.... 

.* 
*. .* 

*. .* 
*NO 



*****G4* ********* 

* IRCW-J * 

* ICDLM=K * 
.X* AMAX=A(J,K1 * 



***************** 



«-*** 

* * 

* F3 *X. 

* * 
**** 



H3 *. 
.* IS * 
.YES .* ANOTHER 
.*. IPIV(K) 

*. =0 

*. .* 

*- .* 
*N0 
**** . 

* * 

* J3 *... 

* * 
**** x 

. *. 
J3 *. 
.* IS * 
i .* ANOTHER 
.*. IPIV(J) 
*. -1 

*. .* 

*. .* 
*N0 



X 

***** 

*FA * 

* B2* 

* * 
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CHART FA 



*****B 2 ********** 

* ADO 1 TO * 

* IPIV(ICOLM) * 



***************** 



*+***Cl********** 

* INTERCHANGE * 

* ROWS IROW * 

* AND *X . 

* ICOLM * 

*, * 

***************** 



C2 *. 

.* IROW= < 

ICOLM 



• X* 



*****D 2 ********** 

* IMD{ 1,11= * 

* IROW * 
IND<I,2I= * 

ICOLM * 



***************** 



*****E 2 ********** 

* DIVIDE * 

* ROW ICOLM * 

* BY AIICOLM, * 

* ICOLM) * 

* * 
***************** 



*****F 2 ********** 

* REDUCE * 

* NON-PIVOT * 

* ROWS * 



***************** 





X 
.*. 
G2 *. 
.* I GT 
NO .* M 


X 
***** 
*EZ * 
* C3* 


*. 
*• 

*■ .* 
*YES 



*****H 2 ********** 
* 1=1 * 



***************** 



*****j 2 ********** 
* L=N+1-I * 



***************** 



B* *. 
IND(I,11* 
INDII.2) 



*****B5********** 

* INTERCHANGE * 

* THOSE * 
.X* ROWS * 



***************** 



*****o*** ******* 
* 1=1+1 * 



***************** 



X 

.*. 

D4 *. 
.* I GT « 

.* M 



***** 
*FA * 
* H2* 



****£4*** ****** 

* RETURN * 

* * 
*************** 
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****A 2 ********* 

* * 

* SUBROUTINE * 

* SCORE * 
*************** 



*****B 2 ******"*** 

* COMPUTE * 

* COMMUNAL- * 

* (TIES * 

* XI I 1**2 * 

* * 
***************** 



*****C2 ********** 

* DIVIDE A * 

* BY UNIOUE- ■ * 

* NESS FACTOR '■■ * 

* 1-X( 11**2 * 

* ■ * 
***************** 



*****D2 ********** 

* COMPUTE * 

* PHI**(-1) * 

* +A**(T+1I * 

* »B * 

* * 
***************** 



*****E2 ********** 

* INVERT * 

* B * 



***************** 



*****F2******« *** 

* COMPUTE * 

* FACTOR * 

* SCORE COEFF. * 



***************** 



******G 2 *********** 

PRINT 

* F.S. * 

COEFF 

* * 

************* 



******H 2 *********** 
READ 
* DATA * 
•X FROM 

* DISK * 

************* 



X 
.*. 



.* LT 
*. 



*. .* 
*NO 



****J3********* 

* * 
•X* RETURN * 

* * 
*************** 



*****B<>********** 

* STANOARD- * 

* IZE X(I> * 



***************** 



*****£ 4********** 

* COMPUTE * 

* FACTOR * 

* SCORES * 

* * 

* * 
***************** 



******D4*** ******** 

PRINT 

* SCORES * 



************* 



* H2 * 

* * 
**** 
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CHART HH 



****A3********* 

* * 

* SUBROUTINE * 

* FMAT * 
*************** 



X 

. *. 

S3 * 

* IPR 

GT 



******B^***** ****** 
SET UP 
* WRITE * 
.X ON 

* TYPEWRITER * 

************* 



******£ 3***** ****** 

SET UP 

* PRINTER * 

WRITE 



************* 



****03********* 

* * 

* RETURN * 

* * 
*************** 
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